Vm-dev September 2013

vm-dev@lists.squeakfoundation.org

31 participants
155 discussions

VM Maker: VMMaker.oscog-eem.347.mcz
by commits＠source.squeak.org 04 Sep '13

04 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.347.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.347 Author: eem Time: 4 September 2013, 2:13:42.682 pm UUID: 20e17c9c-68ab-4d89-9f35-f6f0f0bf4642 Ancestors: VMMaker.oscog-eem.346 Initialize the scavenger. Use scaenger eden limit as the allocation limit, instead of the erroneous use of newSpaceLimit. Rewrite the scavenge methods to use SpurMemoryManager's api. Implement isYoung: and use it in the store check. Implement oldSpace and newSpace enumeration via objectAfter:limit:. Add more protocol to SpurMemMgr (e.g. isContext: et al). =============== Diff against VMMaker.oscog-eem.346 =============== Item was changed: SystemOrganization addCategory: #'VMMaker-Building'! SystemOrganization addCategory: #'VMMaker-JIT'! SystemOrganization addCategory: #'VMMaker-Interpreter'! SystemOrganization addCategory: #'VMMaker-InterpreterSimulation'! SystemOrganization addCategory: #'VMMaker-JITSimulation'! SystemOrganization addCategory: #'VMMaker-Translation to C'! SystemOrganization addCategory: #'VMMaker-Support'! SystemOrganization addCategory: #'VMMaker-PostProcessing'! + SystemOrganization addCategory: #'VMMaker-SpurMemoryManager'! + SystemOrganization addCategory: #'VMMaker-SpurMemoryManagerSimulation'! - SystemOrganization addCategory: #'VMMaker-MemoryManager'! - SystemOrganization addCategory: #'VMMaker-MemoryManagerSimulation'! SystemOrganization addCategory: #'VMMaker-Multithreading'! SystemOrganization addCategory: #'VMMaker-Tests'! SystemOrganization addCategory: #'VMMaker-Plugins'! SystemOrganization addCategory: #'VMMaker-SmartSyntaxPlugins'! SystemOrganization addCategory: #'VMMaker-Plugins-Alien'! Item was changed: VMStructType subclass: #CogObjectHeader instanceVariableNames: 'classIndex unused0 isPinned isImmutable format isMarked isGrey isRemembered objHash slotSize' classVariableNames: '' poolDictionaries: '' + category: 'VMMaker-SpurMemoryManager'! - category: 'VMMaker-MemoryManager'! Item was added: + ----- Method: ObjectMemory>>isContextNonImm: (in category 'contexts') ----- + isContextNonImm: oop + <inline: true> + ^self isContextHeader: (self baseHeader: oop)! Item was changed: Spur32BitMemoryManager subclass: #Spur32BitMMLESimulator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'VMMaker-SpurMemoryManagerSimulation'! - category: 'VMMaker-MemoryManagerSimulation'! Item was changed: ----- Method: Spur32BitMMLESimulator>>headerForSlots:format:classIndex: (in category 'header format') ----- headerForSlots: numSlots format: formatField classIndex: classIndex "The header format in LSB is MSB: | 2 bits | | 22: identityHash | | 8: slotSize | | 3 bits | | 5: format | | 2 bits | | 22: classIndex | : LSB" + self assert: (numSlots bitAnd: self numSlotsMask) = numSlots. + self assert: (formatField bitAnd: self formatMask) = formatField. + self assert: (classIndex bitAnd: self classIndexMask) = classIndex. - self assert: (numSlots between: 0 and: self numSlotsMask). - self assert: (formatField between: 0 and: 31). - self assert: (classIndex between: 0 and: 16r3fffff). ^super headerForSlots: numSlots format: formatField classIndex: classIndex! Item was changed: SpurMemoryManager subclass: #Spur32BitMemoryManager instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'VMMaker-SpurMemoryManager'! - category: 'VMMaker-MemoryManager'! Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | numBytes newObj | "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), 16 bytes otherwise (slot size in preceeding word). Objects always have at least one slot, for the forwarding pointer, and are multiples of 8 bytes in length." numSlots >= self numSlotsMask ifTrue: [newObj := freeStart + self baseHeaderSize. numBytes := self baseHeaderSize + self baseHeaderSize "double header" + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" ifFalse: [newObj := freeStart. numBytes := self baseHeaderSize "single header" + (numSlots <= 1 ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" self assert: numBytes \\ self allocationUnit = 0. freeStart + numBytes > scavengeThreshold ifTrue: + [freeStart + numBytes > scavenger eden limit ifTrue: - [freeStart + numBytes > newSpaceLimit ifTrue: [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. self scheduleScavenge]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: freeStart put: numSlots. self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] ifFalse: [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. self assert: numBytes \\ self allocationUnit = 0. self assert: newObj \\ self allocationUnit = 0. freeStart := freeStart + numBytes. ^newObj! Item was removed: - ----- Method: Spur32BitMemoryManager>>objectAfter: (in category 'object enumeration') ----- - objectAfter: objOop - "Object parsing. - 1. all objects have at least a word following the header, for a forwarding pointer. - 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word - following an object doesn't have a saturated numSlots field it must be a single-header object. - If the word following does have a saturated numSlots it must be the overflow size word." - | followingWordAddress followingWord | - followingWordAddress := self addressAfter: objOop. - followingWordAddress >= freeStart ifTrue: - [^freeStart]. - self flag: #endianness. - followingWord := self longAt: followingWordAddress + 4. - ^followingWord >> self numSlotsHalfShift = self numSlotsMask - ifTrue: [followingWordAddress + self baseHeaderSize] - ifFalse: [followingWordAddress]! Item was added: + ----- Method: Spur32BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') ----- + objectAfter: objOop limit: limit + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word + following an object doesn't have a saturated numSlots field it must be a single-header object. + If the word following does have a saturated numSlots it must be the overflow size word." + | followingWordAddress followingWord | + followingWordAddress := self addressAfter: objOop. + followingWordAddress >= limit ifTrue: + [^limit]. + self flag: #endianness. + followingWord := self longAt: followingWordAddress + 4. + ^followingWord >> self numSlotsHalfShift = self numSlotsMask + ifTrue: [followingWordAddress + self baseHeaderSize] + ifFalse: [followingWordAddress]! Item was changed: ----- Method: Spur32BitMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- + storePointer: fieldIndex ofObject: objOop withValue: valuePointer - storePointer: fieldIndex ofObject: oop withValue: valuePointer "Note must check here for stores of young objects into old ones." + (self isYoung: objOop) ifFalse: "most stores into young objects" - (self oop: oop isLessThan: newSpaceLimit) ifFalse: "most stores into young objects" [(self isImmediate: valuePointer) ifFalse: + [(self isYoung: valuePointer) ifTrue: + [self possibleRootStoreInto: objOop value: valuePointer]]]. - [(self oop: valuePointer isLessThan: newSpaceLimit) ifTrue: - [self possibleRootStoreInto: oop value: valuePointer]]]. ^self + longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - longAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was changed: SpurMemoryManager subclass: #Spur64BitMemoryManager instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'VMMaker-SpurMemoryManager'! - category: 'VMMaker-MemoryManager'! Item was changed: ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | numBytes newObj | "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), 16 bytes otherwise (num slots in preceeding word). Objects always have at least one slot, for the forwarding pointer, and are multiples of 8 bytes in length." numSlots >= self numSlotsMask ifTrue: [numSlots > 16rffffffff ifTrue: [^nil]. newObj := freeStart + self baseHeaderSize. numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" + (numSlots * self bytesPerSlot)] ifFalse: [newObj := freeStart. numBytes := self baseHeaderSize "single header" + (numSlots < 1 ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" ifFalse: [numSlots * self bytesPerSlot])]. freeStart + numBytes > scavengeThreshold ifTrue: + [freeStart + numBytes > scavenger eden limit ifTrue: - [freeStart + numBytes > newSpaceLimit ifTrue: [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. self scheduleScavenge]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: freeStart put: numSlots. self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] ifFalse: [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. freeStart := freeStart + numBytes. ^newObj! Item was removed: - ----- Method: Spur64BitMemoryManager>>objectAfter: (in category 'object enumeration') ----- - objectAfter: objOop - "Object parsing. - 1. all objects have at least a word following the header, for a forwarding pointer. - 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word - following an object doesn't have a saturated numSlots field it must be a single-header object. - If the word following does have a saturated numSlots it must be the overflow size word." - | followingWordAddress followingWord | - followingWordAddress := self addressAfter: objOop. - followingWordAddress >= freeStart ifTrue: - [^freeStart]. - self flag: #endianness. - followingWord := self longAt: followingWordAddress + 4. - ^followingWord >> self numSlotsHalfShift = self numSlotsMask - ifTrue: [followingWordAddress + self baseHeaderSize] - ifFalse: [followingWordAddress]! Item was added: + ----- Method: Spur64BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') ----- + objectAfter: objOop limit: limit + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word + following an object doesn't have a saturated numSlots field it must be a single-header object. + If the word following does have a saturated numSlots it must be the overflow size word." + | followingWordAddress followingWord | + followingWordAddress := self addressAfter: objOop. + followingWordAddress >= limit ifTrue: + [^limit]. + self flag: #endianness. + followingWord := self longAt: followingWordAddress + 4. + ^followingWord >> self numSlotsHalfShift = self numSlotsMask + ifTrue: [followingWordAddress + self baseHeaderSize] + ifFalse: [followingWordAddress]! Item was changed: ----- Method: Spur64BitMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- + storePointer: fieldIndex ofObject: objOop withValue: valuePointer - storePointer: fieldIndex ofObject: oop withValue: valuePointer "Note must check here for stores of young objects into old ones." + (self isYoung: objOop) ifFalse: "most stores into young objects" - (self oop: oop isLessThan: newSpaceLimit) ifFalse: "most stores into young objects" [(self isImmediate: valuePointer) ifFalse: + [(self isYoung: valuePointer) ifTrue: + [self possibleRootStoreInto: objOop value: valuePointer]]]. - [(self oop: valuePointer isLessThan: newSpaceLimit) ifTrue: - [self possibleRootStoreInto: oop value: valuePointer]]]. ^self + longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) - longLongAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was changed: VMClass subclass: #SpurGenerationScavenger + instanceVariableNames: 'coInterpreter manager memory eden futureSpace pastSpace rememberedSet rememberedSetSize' - instanceVariableNames: 'coInterpreter manager memory futureSpace pastSpace rememberedSet rememberedSetSize' classVariableNames: '' poolDictionaries: '' + category: 'VMMaker-SpurMemoryManager'! - category: 'VMMaker-MemoryManager'! Item was changed: + ----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') ----- - ----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'api') ----- copyAndForward: survivor "copyAndForward: survivor copies a survivor object either to futureSurvivorSpace or, if it is to be promoted, to oldSpace. It leaves a forwarding pointer behind." - <var: #survivor type: #'object *'> | newLocation | newLocation := (self shouldBeTenured: survivor) ifTrue: [self copyToOldSpace: survivor] ifFalse: [self copyToFutureSpace: survivor]. manager forward: survivor to: newLocation ! Item was added: + ----- Method: SpurGenerationScavenger>>eden (in category 'accessing') ----- + eden + <returnTypeC: #'SpurNewSpaceSpace *'> + ^self addressOf: eden! Item was added: + ----- Method: SpurGenerationScavenger>>futureSpace (in category 'accessing') ----- + futureSpace + <returnTypeC: #'SpurNewSpaceSpace *'> + ^self addressOf: futureSpace! Item was added: + ----- Method: SpurGenerationScavenger>>initPastSpaceForObjectEnumeration (in category 'initialization') ----- + initPastSpaceForObjectEnumeration + "For SuurMemoryManager allNewSpaceObjectsDo: fill pastSpace with + a single empty object." + | objOop | + manager initFreeChunkWithBytes: pastSpace limit - pastSpace start at: pastSpace start. + objOop := manager objectStartingAt: pastSpace start. + self assert: (manager addressAfter: objOop) = pastSpace limit! Item was added: + ----- Method: SpurGenerationScavenger>>manager:memory:newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') ----- + manager: aSpurMemoryManager memory: memoryArray newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes + | edenBytes edenLimit edenStart survivorBytes | + manager := aSpurMemoryManager. + memory := memoryArray. + edenBytes := requestedEdenBytes. + edenStart := startAddress. + survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit. + edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit. + edenLimit := edenStart + edenBytes roundUpTo: manager allocationUnit. + self assert: totalBytes - (edenLimit - edenStart) - survivorBytes - survivorBytes < manager allocationUnit. + eden := SpurNewSpaceSpace new. + pastSpace := SpurNewSpaceSpace new. + futureSpace := SpurNewSpaceSpace new. + eden start: edenStart limit: edenLimit. + pastSpace start: edenLimit limit: edenLimit + survivorBytes. + futureSpace start: pastSpace limit limit: pastSpace limit + survivorBytes. + self assert: futureSpace limit <= (startAddress + totalBytes). + self assert: eden start \\ manager allocationUnit + + (eden limit \\ manager allocationUnit) = 0. + self assert: pastSpace start \\ manager allocationUnit + + (pastSpace limit \\ manager allocationUnit) = 0. + self assert: futureSpace start \\ manager allocationUnit + + (futureSpace limit \\ manager allocationUnit) = 0. + self initPastSpaceForObjectEnumeration! Item was added: + ----- Method: SpurGenerationScavenger>>pastSpace (in category 'accessing') ----- + pastSpace + <returnTypeC: #'SpurNewSpaceSpace *'> + ^self addressOf: pastSpace! Item was changed: + ----- Method: SpurGenerationScavenger>>scavenge (in category 'scavenger') ----- - ----- Method: SpurGenerationScavenger>>scavenge (in category 'api') ----- scavenge "The main routine, scavenge, scavenges young objects reachable from the roots (the stack zone and the rememberedTable). It first scavenges the new objects immediately reachable from the stack zone, then those directly from old ones (all in the remembered table). Then it scavenges those that are transitively reachable. If this results in a promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from the promoted. This loop continues until no more reachable objects are left. At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace. Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize and previousFutureSurvivorSpaceSize variables ensure that no object is scanned twice, as well as detecting closure. If this were not true, some pointers might get forwarded twice." coInterpreter scavengeStacks. self scavengeLoop. self exchange: pastSpace with: futureSpace! Item was changed: + ----- Method: SpurGenerationScavenger>>scavengeFutureSurvivorSpaceStartingAt: (in category 'scavenger') ----- - ----- Method: SpurGenerationScavenger>>scavengeFutureSurvivorSpaceStartingAt: (in category 'api') ----- scavengeFutureSurvivorSpaceStartingAt: initialAddress "scavengeFutureSurvivorSpaceStartingAt: does a depth-first traversal of the + new objects starting at the one at initialAddress in futureSurvivorSpace." - new objects starting at the one at the nth word of futureSurvivorSpace." | ptr | - <var: #ptr type: #'char *'> ptr := initialAddress. [ptr < futureSpace limit] whileTrue: [| obj | + obj := manager objectStartingAt: ptr. + ptr := manager addressAfter: obj. + self cCoerceSimple: (self scavengeReferentsOf: obj) to: #void]! - obj := manager objectAt: ptr. - ptr := ptr + (manager byteLengthOf: obj). - self cCoerceSimple: (self scavengeReferentsOf: obj) - to: #void]! Item was changed: + ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'scavenger') ----- - ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'api') ----- scavengeLoop "This is the inner loop of the main routine, scavenge. It first scavenges the new objects immediately reachable from old ones. Then it scavenges those that are transitively reachable. If this results in a promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from the promoted. This loop continues until no more reachable objects are left. At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace. Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as detecting closure. If this were not true, some pointers might get forwarded twice." | previousRememberedSetSize previousFutureSurvivorSpaceLimit | previousRememberedSetSize := 0. previousFutureSurvivorSpaceLimit := futureSpace limit. self assert: futureSpace limit = futureSpace start. [self scavengeRememberedSetStartingAt: previousRememberedSetSize. previousFutureSurvivorSpaceLimit = futureSpace limit ifTrue: [^self]. previousRememberedSetSize := rememberedSetSize. self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorSpaceLimit. previousFutureSurvivorSpaceLimit = rememberedSetSize ifTrue: [^self]. previousFutureSurvivorSpaceLimit := futureSpace size] repeat! Item was changed: + ----- Method: SpurGenerationScavenger>>scavengeReferentsOf: (in category 'scavenger') ----- - ----- Method: SpurGenerationScavenger>>scavengeReferentsOf: (in category 'api') ----- scavengeReferentsOf: referrer "scavengeReferentsOf: referrer inspects all the pointers in referrer. If any are new objects, it has them moved to FutureSurvivorSpace, and returns truth. If there are no new referents, it returns falsity." <var: #referrer type: #'object *'> + | foundNewReferent | + "referrer isPointers ifFalse: + [^false]." - | foundNewReferent referent | - referrer isPointers ifFalse: - [^self]. foundNewReferent := false. + 0 to: (manager numPointerSlotsOf: referrer) do: + [:i| | referent | - 0 to: (manager lengthOf: referrer) do: - [:i| referent := manager fetchPointer: i ofObject: referrer. + ((manager isNonImmediate: referent) + and: [manager isYoung: referent]) ifTrue: - (manager isYoung: referent) ifTrue: [foundNewReferent := true. + (manager isForwarded: referent) ifFalse: - referent isForwarded ifFalse: [self copyAndForward: referent]. manager storePointerUnchecked: i ofObject: referrer withValue: (manager forwardingPointerOf: referent)]]. ^foundNewReferent! Item was changed: + ----- Method: SpurGenerationScavenger>>scavengeRememberedSetStartingAt: (in category 'scavenger') ----- - ----- Method: SpurGenerationScavenger>>scavengeRememberedSetStartingAt: (in category 'api') ----- scavengeRememberedSetStartingAt: n "scavengeRememberedSetStartingAt: n traverses objects in the remembered set starting at the nth one. If the object does not refer to any new objects, it is removed from the set. Otherwise, its new referents are scavenged." | destIndex sourceIndex | sourceIndex := destIndex := n. [sourceIndex < rememberedSetSize] whileTrue: [| referree | referree := rememberedSet at: sourceIndex. (self scavengeReferentsOf: referree) ifTrue: [rememberedSet at: destIndex put: referree. destIndex := destIndex + 1] ifFalse: [referree isRemembered: false]. sourceIndex := sourceIndex + 1]. rememberedSetSize := destIndex! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was added: + ----- Method: SpurMemoryManager>>addressCouldBeObj: (in category 'debug support') ----- + addressCouldBeObj: address + ^(address bitAnd: self baseHeaderSize - 1) = 0 + and: [(self isInOldSpace: address) + or: [(self isInEden: address) + or: [self isInSurvivorSpace: address]]]! Item was changed: ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'initialization') ----- adjustAllOopsBy: bytesToShift "Adjust all oop references by the given number of bytes. This is done just after reading in an image when the new base address of the object heap is different from the base address in the image." - "di 11/18/2000 - return number of objects found" | obj | <inline: false> bytesToShift ~= 0 ifTrue: + [self assert: self newSpaceIsEmpty. + obj := self firstObject. + [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: - [obj := self firstObject. - [self oop: obj isLessThan: freeStart] whileTrue: [(self isFreeObject: obj) ifFalse: [self adjustFieldsAndClassOf: obj by: bytesToShift]. obj := self objectAfter: obj]]! Item was added: + ----- Method: SpurMemoryManager>>allNewSpaceObjectsDo: (in category 'object enumeration') ----- + allNewSpaceObjectsDo: aBlock + | prevObj prevPrevObj objOop limit | + prevPrevObj := prevObj := nil. + "After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are + in pastSpace. Objects are allocated in eden. So enumerate only eden and pastSpace." + objOop := self objectStartingAt: scavenger eden start. + [objOop < freeStart] whileTrue: + [(self isFreeObject: objOop) ifFalse: + [aBlock value: objOop]. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := self objectAfter: objOop limit: freeStart]. + objOop := self objectStartingAt: scavenger pastSpace start. + limit := scavenger pastSpace limit. + [objOop < limit] whileTrue: + [(self isFreeObject: objOop) ifFalse: + [aBlock value: objOop]. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := self objectAfter: objOop limit: limit]. + prevPrevObj class. + prevObj class! Item was changed: + ----- Method: SpurMemoryManager>>allObjectsDo: (in category 'object enumeration') ----- - ----- Method: SpurMemoryManager>>allObjectsDo: (in category 'debug support') ----- allObjectsDo: aBlock + self allOldSpaceObjectsDo: aBlock. + self allNewSpaceObjectsDo: aBlock! - <doNotGenerate> - | prevObj prevPrevObj objOop | - prevPrevObj := prevObj := nil. - objOop := self firstObject. - [self assert: objOop \\ self allocationUnit = 0. - objOop < freeStart] whileTrue: - [(self isFreeObject: objOop) ifFalse: - [aBlock value: objOop]. - prevPrevObj := prevObj. - prevObj := objOop. - objOop := self objectAfter: objOop]. - prevPrevObj class. - prevObj class! Item was added: + ----- Method: SpurMemoryManager>>allOldSpaceObjectsDo: (in category 'object enumeration') ----- + allOldSpaceObjectsDo: aBlock + <doNotGenerate> + | prevObj prevPrevObj objOop | + prevPrevObj := prevObj := nil. + objOop := self firstObject. + [self assert: objOop \\ self allocationUnit = 0. + objOop < freeOldSpaceStart] whileTrue: + [(self isFreeObject: objOop) ifFalse: + [aBlock value: objOop]. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := self objectAfter: objOop limit: freeOldSpaceStart]. + prevPrevObj class. + prevObj class! Item was removed: - ----- Method: SpurMemoryManager>>allocateMemoryOfSize: (in category 'simulation') ----- - allocateMemoryOfSize: limit - <doNotGenerate> - memory := (self endianness == #little - ifTrue: [LittleEndianBitmap] - ifFalse: [Bitmap]) new: (limit roundUpTo: 8). - freeStart := startOfMemory := 0. - scavengeThreshold := newSpaceLimit := memory size * 4 "Bitmap is a 4-byte per word array"! Item was changed: ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') ----- allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes + "Intialize the receiver for bootsraping an image. + Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold + to allocate in oldSpace. Later on (in initializePostBootstrap) freeStart and scavengeThreshold + will be set to sane values." <doNotGenerate> self assert: (memoryBytes \\ self allocationUnit = 0 and: [newSpaceBytes \\ self allocationUnit = 0 and: [codeBytes \\ self allocationUnit = 0]]). memory := (self endianness == #little ifTrue: [LittleEndianBitmap] ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4. startOfMemory := codeBytes. endOfMemory := memoryBytes + newSpaceBytes + codeBytes. "leave newSpace empty for the bootstrap" freeStart := newSpaceBytes + startOfMemory. newSpaceStart := startOfMemory. newSpaceLimit := newSpaceBytes + startOfMemory. + scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array" + scavenger := SpurGenerationScavenger new + manager: self + memory: memory + newSpaceStart: newSpaceStart + newSpaceBytes: newSpaceBytes + edenBytes: newSpaceBytes * 5 // 7 "David's paper uses 140Kb eden + 2 x 28kb survivor spaces :-)"! - scavengeThreshold := memory size * 4 "Bitmap is a 4-byte per word array"! Item was added: + ----- Method: SpurMemoryManager>>byteLengthOf: (in category 'object access') ----- + byteLengthOf: objOop + "Answer the number of indexable bytes in the given object. + Does not adjuect contexts by stackPointer." + | fmt numBytes | + <inline: true> + <asmLabel: false> + fmt := self formatOf: objOop. + numBytes := (self numSlotsOf: objOop) << self shiftForWord. + fmt <= self sixtyFourBitIndexableFormat ifTrue: + [^numBytes]. + fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod" + [^numBytes - (fmt bitAnd: 7)]. + fmt >= self firstShortFormat ifTrue: + [^numBytes - ((fmt bitAnd: 3) << 1)]. + "fmt >= self firstLongFormat" + ^numBytes - ((fmt bitAnd: 1) << 2)! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." "Assume: image reader initializes the following variables: memory memoryLimit specialObjectsOop lastHash " <inline: false> "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. + self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart" - self initializeOldSpaceFirstFree: endOfOldSpace. "initializes endOfMemory, freeStart" specialObjectsOop := specialObjectsOop + bytesToShift. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "rootTableCount := 0. rootTableOverflowed := false. lowSpaceThreshold := 0. signalLowSpace := false. compStart := 0. compEnd := 0. fwdTableNext := 0. fwdTableLast := 0. remapBufferCount := 0. tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold"" growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing"" shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking"" ""garbage collection statistics"" statFullGCs := 0. statFullGCUsecs := 0. statIncrGCs := 0. statIncrGCUsecs := 0. statTenures := 0. statRootTableOverflows := 0. statGrowMemory := 0. statShrinkMemory := 0. forceTenureFlag := 0. gcBiasToGrow := 0. gcBiasToGrowGCLimit := 0. extraRootCount := 0."! Item was changed: ----- Method: SpurMemoryManager>>initializePostBootstrap (in category 'simulation') ----- initializePostBootstrap "The heap has just been bootstrapped into a modified newSpace occupying all of memory above newSPace (and the codeZone). Put things back to some kind of normalicy." + freeOldSpaceStart := freeStart. + freeStart := scavenger eden start! - endOfOldSpace := freeStart. - freeStart := newSpaceStart! Item was added: + ----- Method: SpurMemoryManager>>isContext: (in category 'object testing') ----- + isContext: oop + <inline: true> + ^(self isNonImmediate: oop) + and: [(self classIndexOf: oop) = ClassMethodContextCompactIndex]! Item was added: + ----- Method: SpurMemoryManager>>isContextNonImm: (in category 'object testing') ----- + isContextNonImm: oop + <inline: true> + ^(self classIndexOf: oop) = ClassMethodContextCompactIndex! Item was added: + ----- Method: SpurMemoryManager>>isForwarded: (in category 'object testing') ----- + isForwarded: objOop + ^(self classIndexOf: objOop) = self isForwardedClassIndexPun! Item was added: + ----- Method: SpurMemoryManager>>isForwardedClassIndexPun (in category 'class table') ----- + isForwardedClassIndexPun + ^1! Item was added: + ----- Method: SpurMemoryManager>>isFreeClassIndexPun (in category 'class table') ----- + isFreeClassIndexPun + ^0! Item was changed: + ----- Method: SpurMemoryManager>>isFreeObject: (in category 'object testing') ----- - ----- Method: SpurMemoryManager>>isFreeObject: (in category 'header access') ----- isFreeObject: objOop + ^(self classIndexOf: objOop) = self isFreeClassIndexPun! - ^(self classIndexOf: objOop) = 0! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop + (#( makeBaseFrameFor: + quickFetchInteger:ofObject: + frameOfMarriedContext:) includes: thisContext sender method selector) ifFalse: - (#(makeBaseFrameFor: quickFetchInteger:ofObject:) includes: thisContext sender method selector) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was added: + ----- Method: SpurMemoryManager>>isYoung: (in category 'object testing') ----- + isYoung: objOop + ^self oop: objOop isLessThan: newSpaceLimit! Item was changed: ----- Method: SpurMemoryManager>>lastPointerOf: (in category 'object enumeration') ----- + lastPointerOf: objOop - lastPointerOf: obj "Answer the byte offset of the last pointer field of the given object. Works with CompiledMethods, as well as ordinary objects." <api> <inline: true> <asmLabel: false> + | fmt contextSize numLiterals | + fmt := self formatOf: objOop. - | fmt header contextSize numLiterals | - <var: 'header' type: #usqLong> - header := self baseHeader: obj. - fmt := self formatOfHeader: header. fmt <= self lastPointerFormat ifTrue: [(fmt = self indexablePointersFormat + and: [self isContextNonImm: objOop]) ifTrue: - and: [self isContextHeader: header]) ifTrue: ["contexts end at the stack pointer" + contextSize := coInterpreter fetchStackPointerOf: objOop. - contextSize := coInterpreter fetchStackPointerOf: obj. ^CtxtTempFrameStart + contextSize * BytesPerOop]. + ^(self numSlotsOf: objOop) * BytesPerOop "all pointers"]. - ^(self numSlotsOf: obj) * BytesPerOop "all pointers"]. fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" "CompiledMethod: contains both pointers and bytes" + numLiterals := coInterpreter literalCountOf: objOop. - numLiterals := coInterpreter literalCountOf: obj. ^numLiterals + LiteralStart * BytesPerOop! Item was added: + ----- Method: SpurMemoryManager>>numPointerSlotsOf: (in category 'object enumeration') ----- + numPointerSlotsOf: objOop + "Answer the number of pointer fields in the given object. + Works with CompiledMethods, as well as ordinary objects." + <api> + <inline: true> + <asmLabel: false> + | fmt contextSize numLiterals | + fmt := self formatOf: objOop. + fmt <= self lastPointerFormat ifTrue: + [(fmt = self indexablePointersFormat + and: [self isContextNonImm: objOop]) ifTrue: + ["contexts end at the stack pointer" + contextSize := coInterpreter fetchStackPointerOf: objOop. + ^CtxtTempFrameStart + contextSize]. + ^self numSlotsOf: objOop "all pointers"]. + fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" + + "CompiledMethod: contains both pointers and bytes" + numLiterals := coInterpreter literalCountOf: objOop. + ^numLiterals + LiteralStart! Item was added: + ----- Method: SpurMemoryManager>>objectStartingAt: (in category 'object enumeration') ----- + objectStartingAt: address + "For enumerating objects find the header of the first object in a space. + If the object starts with an overflow size field it will start at the next allocationUnit. + c.f. numSlotsOf:" + | halfHeader numSlots | + self flag: #endianness. + halfHeader := self longAt: address + 4. + numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. + ^numSlots = self numSlotsMask + ifTrue: [address + self baseHeaderSize] + ifFalse: [address]! Item was added: + VMStructType subclass: #SpurNewSpaceSpace + instanceVariableNames: 'start limit' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-SpurMemoryManager'! Item was added: + ----- Method: SpurNewSpaceSpace>>limit (in category 'accessing') ----- + limit + ^limit! Item was added: + ----- Method: SpurNewSpaceSpace>>start (in category 'accessing') ----- + start + ^start! Item was added: + ----- Method: SpurNewSpaceSpace>>start:limit: (in category 'initialization') ----- + start: startAddress limit: limitAddress + start := startAddress. + limit := limitAddress!

1 0

VM Maker: VMMaker.oscog-eem.346.mcz
by commits＠source.squeak.org 04 Sep '13

04 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.346.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.346 Author: eem Time: 3 September 2013, 5:47:46.282 pm UUID: 4eed4dd7-7283-4f8b-82f1-53e3aeb6a98e Ancestors: VMMaker.oscog-eem.345 Fix bug in transferTo:[from:] passing wrong stackPointer to marryFrame:... Move StackInterpreter/NewObjectMemory et al away from Small/LargeContextSize to Small/LargeContextSlots for Spur. Add more protocol. Bootstrap gets into initial marryFrame:. =============== Diff against VMMaker.oscog-eem.345 =============== Item was changed: ----- Method: CoInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') ----- interpreterAllocationReserveBytes "At a rough approximation we may need to allocate up to a couple of page's worth of contexts when switching stack pages, assigning to senders, etc. But the snapshot primitive voids all stack pages. So a safe margin is the size of a large context times the maximum number of frames per page times the number of pages." | maxUsedBytesPerPage maxFramesPerPage | maxUsedBytesPerPage := self stackPageFrameBytes + self stackLimitOffset. maxFramesPerPage := maxUsedBytesPerPage / BytesPerWord // MFrameSlots. + ^maxFramesPerPage * LargeContextSlots * BytesPerOop * numStackPages! - ^maxFramesPerPage * LargeContextSize * numStackPages! Item was changed: ----- Method: CoInterpreter>>marryFrame:SP:copyTemps: (in category 'frame access') ----- marryFrame: theFP SP: theSP copyTemps: copyTemps "Marry an unmarried frame. This means creating a spouse context initialized with a subset of the frame's state that references the frame. For the default closure implementation we do not need to copy temps. Different closure implementations may require temps to be copied. This method is important enough for performance to be worth streamlining. Override to set the ``has context'' flag appropriately for both machine code and interpreter frames and to streamline the machine code/interpreter differences.." + | theContext methodFieldOrObj closureOrNil rcvr numSlots numArgs numStack numTemps | - | theContext methodFieldOrObj closureOrNil rcvr byteSize numArgs numStack numTemps | <inline: true> <var: #theFP type: #'char *'> <var: #theSP type: #'char *'> <var: #cogMethod type: #'CogMethod *'> self assert: (self frameHasContext: theFP) not. self assert: (self isBaseFrame: theFP) not. "base frames must aready be married for cannotReturn: processing" + "The SP is expected to be pointing at the last oop on the stack, not at the pc" + self assert: (objectMemory addressCouldBeOop: (objectMemory longAt: theSP)). + "Decide how much of the stack to preserve in widowed contexts. Preserving too much state will potentially hold onto garbage. Holding onto too little may mean that a dead context isn't informative enough in a debugging situation. If copyTemps is false (as it is in the default closure implementation) compromise, retaining only the arguments with no temporaries. Note that we still set the stack pointer to its current value, but stack contents other than the arguments are nil." methodFieldOrObj := self frameMethodField: theFP. methodFieldOrObj asUnsignedInteger < objectMemory startOfMemory "inline (self isMachineCodeFrame: theFP)" ifTrue: [| cogMethod | stackPages longAt: theFP + FoxMethod put: methodFieldOrObj + MFMethodFlagHasContextFlag. cogMethod := self cCoerceSimple: (methodFieldOrObj bitAnd: MFMethodMask) to: #'CogMethod *'. numArgs := cogMethod cmNumArgs. cogMethod cmType = CMMethod ifTrue: [closureOrNil := objectMemory nilObject] ifFalse: [cogMethod := (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod. closureOrNil := self frameStackedReceiver: theFP numArgs: numArgs]. + numSlots := (cogMethod methodHeader bitAnd: LargeContextBit) ~= 0 + ifTrue: [LargeContextSlots] + ifFalse: [SmallContextSlots]. - byteSize := (cogMethod methodHeader bitAnd: LargeContextBit) ~= 0 - ifTrue: [LargeContextSize] - ifFalse: [SmallContextSize]. methodFieldOrObj := cogMethod methodObject. rcvr := self mframeReceiver: theFP. numStack := self stackPointerIndexForMFrame: theFP WithSP: theSP numArgs: numArgs] ifFalse: [self setIFrameHasContext: theFP. numArgs := self iframeNumArgs: theFP. + numSlots := ((self headerOf: methodFieldOrObj) bitAnd: LargeContextBit) ~= 0 + ifTrue: [LargeContextSlots] + ifFalse: [SmallContextSlots]. - byteSize := ((self headerOf: methodFieldOrObj) bitAnd: LargeContextBit) ~= 0 - ifTrue: [LargeContextSize] - ifFalse: [SmallContextSize]. closureOrNil := (self iframeIsBlockActivation: theFP) ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs] ifFalse: [objectMemory nilObject]. rcvr := self iframeReceiver: theFP. numStack := self stackPointerIndexForIFrame: theFP WithSP: theSP numArgs: numArgs]. + theContext := objectMemory eeInstantiateMethodContextSlots: numSlots. - theContext := objectMemory eeInstantiateMethodContextByteSize: byteSize. self setFrameContext: theFP to: theContext. "Mark context as married by setting its sender to the frame pointer plus SmallInteger tags and the InstructionPointer to the saved fp (which ensures correct alignment w.r.t. the frame when we check for validity)" objectMemory storePointerUnchecked: SenderIndex ofObject: theContext withValue: (self withSmallIntegerTags: theFP). objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: theContext withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)). objectMemory storePointerUnchecked: StackPointerIndex ofObject: theContext withValue: (objectMemory integerObjectOf: numStack). objectMemory storePointerUnchecked: MethodIndex ofObject: theContext withValue: methodFieldOrObj. objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil. objectMemory storePointerUnchecked: ReceiverIndex ofObject: theContext withValue: rcvr. 1 to: numArgs do: [:i| objectMemory storePointerUnchecked: ReceiverIndex + i ofObject: theContext withValue: (self temporary: i - 1 in: theFP)]. copyTemps ifTrue: [numTemps := self frameNumTemps: theFP. 1 to: numTemps do: [:i| objectMemory storePointerUnchecked: ReceiverIndex + i + numArgs ofObject: theContext withValue: (self temporary: i - 1 in: theFP)]. numArgs := numArgs + numTemps]. numArgs + 1 to: numStack do: [:i| objectMemory storePointerUnchecked: ReceiverIndex + i ofObject: theContext withValue: objectMemory nilObject]. self assert: (self frameHasContext: theFP). self assert: (self frameOfMarriedContext: theContext) = theFP. self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext). ^theContext! Item was changed: ----- Method: CoInterpreter>>roomToPushNArgs: (in category 'primitive support') ----- roomToPushNArgs: n "Answer if there is room to push n arguments onto the current stack. There may be room in this stackPage but there may not be room if the frame were converted into a context." | methodHeader cntxSize | (self isMachineCodeFrame: framePointer) ifTrue: [methodHeader := (self mframeHomeMethod: framePointer) methodHeader] ifFalse: [methodHeader := self headerOf: (self iframeMethod: framePointer)]. cntxSize := (methodHeader bitAnd: LargeContextBit) ~= 0 + ifTrue: [LargeContextSlots - ReceiverIndex] + ifFalse: [SmallContextSlots - ReceiverIndex]. - ifTrue: [LargeContextSize / BytesPerWord - ReceiverIndex] - ifFalse: [SmallContextSize / BytesPerWord - ReceiverIndex]. ^self stackPointerIndex + n <= cntxSize! Item was changed: ----- Method: CoInterpreter>>transferTo:from: (in category 'process primitive support') ----- transferTo: newProc from: sourceCode "Record a process to be awoken on the next interpreter cycle. Reimplement to record the source of the switch for debugging, and to cope with possible code compaction in makeBaseFrameFor:." | activeContext sched oldProc | <inline: false> self recordContextSwitchFrom: self activeProcess in: sourceCode. statProcessSwitch := statProcessSwitch + 1. self push: instructionPointer. self externalWriteBackHeadFramePointers. self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer. "ensureMethodIsCogged: in makeBaseFrameFor: in externalSetStackPageAndPointersForSuspendedContextOfProcess: below may do a code compaction. Nil instructionPointer to avoid it getting pushed twice." instructionPointer := 0. sched := self schedulerPointer. oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched. + activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer + BytesPerWord. - activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext. objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc. objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject. self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc! Item was added: + ----- Method: NewObjectMemory>>eeInstantiateMethodContextSlots: (in category 'interpreter access') ----- + eeInstantiateMethodContextSlots: numSlots + "This version of instantiateClass assumes that the total object + size is under 256 bytes, the limit for objects with only one or + two header words. Note that the size is specified in bytes + and should include four bytes for the base header word. + Will *not* cause a GC." + | sizeInBytes hash header1 | + self assert: (numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]). + sizeInBytes := numSlots * BytesPerOop + BaseHeaderSize. + self assert: sizeInBytes <= SizeMask. + hash := self newObjectHash. + header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: self formatOfMethodContextMinusSize. + self assert: (header1 bitAnd: CompactClassMask) > 0. "contexts must be compact" + self assert: (header1 bitAnd: SizeMask) = 0. + "OR size into header1. Must not do this if size > SizeMask" + header1 := header1 + sizeInBytes. + ^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: nil h3: nil! Item was removed: - ----- Method: NewObjectMemory>>fixContextSizes (in category 'initialization') ----- - fixContextSizes - "Correct context sizes at start-up." - | numBadContexts obj oop map delta hdr len i methodContextProtoIndex methodContextProto | - <var: #map type: #'sqInt *'> - methodContextProto := self splObj: (methodContextProtoIndex := 35). - ((self isContext: methodContextProto) - and: [self badContextSize: methodContextProto]) ifTrue: - [self splObj: methodContextProtoIndex put: nilObj. - "If it is unreferenced except here; nuke it, otherwise resize it" - (self numReferencesTo: methodContextProto) = 0 ifTrue: - [self freeObject: methodContextProto]]. - "Count the number of bad contexts" - numBadContexts := 0. - obj := self firstObject. - [obj < freeStart] whileTrue: - [((self isFreeObject: obj) not - and: [(self isContextNonInt: obj) - and: [self badContextSize: obj]]) ifTrue: - [numBadContexts := numBadContexts + 1]. - obj := self objectAfter: obj]. - numBadContexts = 0 ifTrue: - [^self]. - "Allocate a map of pairs of context obj and how much it has to move." - map := self cCode: [self malloc: numBadContexts + 1 * 2 * BytesPerOop] - inSmalltalk: [CArrayAccessor on: (Array new: numBadContexts + 1 * 2)]. - "compute the map" - numBadContexts := 0. - delta := 0. - obj := self firstObject. - [obj < freeStart] whileTrue: - [((self isFreeObject: obj) not - and: [(self isContextNonInt: obj) - and: [self badContextSize: obj]]) ifTrue: - [delta := ((self byteLengthOf: obj) > SmallContextSize - ifTrue: [LargeContextSize] - ifFalse: [SmallContextSize]) - (self byteLengthOf: obj). - map at: numBadContexts put: (self objectAfter: obj). - numBadContexts = 0 - ifTrue: [map at: numBadContexts + 1 put: delta] - ifFalse: [map at: numBadContexts + 1 put: delta + (map at: numBadContexts - 1)]. - numBadContexts := numBadContexts + 2]. - obj := self objectAfter: obj]. - "block-move the segments to make room for the resized contexts" - map at: numBadContexts put: freeStart. - self assert: freeStart = youngStart. "designed to be run at startup" - freeStart := freeStart + (map at: numBadContexts - 1). - youngStart := freeStart. - [(numBadContexts := numBadContexts - 2) >= 0] whileTrue: - [obj := map at: numBadContexts. - oop := map at: numBadContexts + 2. - self mem: "dest" obj + (map at: numBadContexts + 1) - mo: "src" obj - ve: "len" oop - obj]. - "now fix-up objs, resizing wrongly-sized contexts along the way." - obj := self firstObject. - [obj < freeStart] whileTrue: - [(self isFreeObject: obj) not ifTrue: - [((self isContextNonInt: obj) - and: [self badContextSize: obj]) ifTrue: - [hdr := self baseHeader: obj. - len := (hdr bitAnd: SizeMask) > SmallContextSize ifTrue: [LargeContextSize] ifFalse: [SmallContextSize]. - self baseHeader: obj put: ((hdr bitClear: SizeMask) bitOr: len). - "now check the enumeration" - oop := self objectAfter: obj. - self assert: oop <= freeStart. - numBadContexts := 0. - [oop > (map at: numBadContexts)] whileTrue: - [numBadContexts := numBadContexts + 2]. - self assert: oop = ((map at: numBadContexts) + (map at: numBadContexts + 1))]. - (self headerType: obj) ~= HeaderTypeShort ifTrue: "see remapClassOf:" - [oop := (hdr := self longAt: obj - BytesPerWord) bitAnd: AllButTypeMask. - oop >= (map at: 0) ifTrue: - [numBadContexts := 2. - [oop >= (map at: numBadContexts)] whileTrue: - [numBadContexts := numBadContexts + 2]. - hdr := oop + (map at: numBadContexts - 1) + (hdr bitAnd: TypeMask). - self longAt: obj - BytesPerWord put: hdr]]. - ((self isPointersNonInt: obj) or: [self isCompiledMethod: obj]) ifTrue: - [(self isCompiledMethod: obj) - ifTrue: - [i := (self literalCountOf: obj) + LiteralStart] - ifFalse: - [(self isContextNonInt: obj) - ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj)] - ifFalse: [i := self lengthOf: obj]]. - [(i := i - 1) >= 0] whileTrue: - [oop := self fetchPointer: i ofObject: obj. - ((self isNonIntegerObject: oop) - and: [oop >= (map at: 0)]) ifTrue: - [numBadContexts := 2. - [oop >= (map at: numBadContexts)] whileTrue: - [numBadContexts := numBadContexts + 2]. - self storePointerUnchecked: i ofObject: obj withValue: oop + (map at: numBadContexts - 1)]]]]. - obj := self objectAfter: obj]. - self clearLeakMapAndMapAccessibleObjects. - (self asserta: self checkHeapIntegrity) ifFalse: - [self error: 'failed to resize contexts correctly']! Item was added: + ----- Method: NewObjectMemory>>goodContextSize: (in category 'contexts') ----- + goodContextSize: oop + | numSlots | + numSlots := self numSlotsOf: oop. + ^numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]! Item was added: + ----- Method: NewObjectMemory>>numSlotsOf: (in category 'interpreter access') ----- + numSlotsOf: obj + "Answer the number of oop-sized elements in the given object. + Unlike lengthOf: this does not adjust the length of a context + by the stackPointer and so can be used e.g. by cloneContext:" + <api> + | header sz | + header := self baseHeader: obj. + sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass + ifTrue: [(self sizeHeader: obj) bitAnd: AllButTypeMask] + ifFalse: [header bitAnd: SizeMask]. + ^sz - BaseHeaderSize >> ShiftForWord! Item was added: + ----- Method: Spur32BitMemoryManager>>integerObjectOf: (in category 'immediates') ----- + integerObjectOf: value + "Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object. + In C, use a shift and an add to set the tag bit. + In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns." + + ^self + cCode: [value << 1 + 1] + inSmalltalk: [value >= 0 + ifTrue: [value << 1 + 1] + ifFalse: [16r80000000 + value << 1 + 1]]! Item was added: + ----- Method: Spur32BitMemoryManager>>integerValueOf: (in category 'immediates') ----- + integerValueOf: oop + "Translator produces 'oop >> 1'" + ^(oop bitShift: -31) = 1 "tests top bit" + ifTrue: "negative" + [((oop bitShift: -1) bitAnd: 16r3FFFFFFF) - 16r3FFFFFFF - 1 "Faster than -16r40000000 (a LgInt)"] + ifFalse: "positive" + [oop bitShift: -1]! Item was added: + ----- Method: Spur64BitMemoryManager>>integerObjectOf: (in category 'immediates') ----- + integerObjectOf: value + "Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object. + In C, use a shift and an add to set the tag bit. + In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns." + + ^self + cCode: [value << self numTagBits + 1] + inSmalltalk: [value << self numTagBits + + (value >= 0 + ifTrue: [1] + ifFalse: [16r8000000000000001])]! Item was added: + ----- Method: Spur64BitMemoryManager>>integerValueOf: (in category 'immediates') ----- + integerValueOf: oop + "Translator produces 'oop >> 1'" + ^(oop bitShift: -63) = 1 "tests top bit" + ifTrue: "negative" + [((oop bitShift: self numTagBits negated) bitAnd: 16r3FFFFFFFFFFFFFFF) - 16r3FFFFFFFFFFFFFFF - 1 "Faster than -16r4000000000000000 (a LgInt)"] + ifFalse: "positive" + [oop bitShift: self numTagBits negated]! Item was added: + ----- Method: SpurMemoryManager>>goodContextSize: (in category 'object testing') ----- + goodContextSize: oop + | numSlots | + numSlots := self numSlotsOf: oop. + ^numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]! Item was changed: ----- Method: SpurMemoryManager>>integerObjectOf: (in category 'immediates') ----- integerObjectOf: value "Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object. In C, use a shift and an add to set the tag bit. In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns." + ^self subclassResponsibility! - - ^self - cCode: [(value << 1) + 1] - inSmalltalk: [value >= 0 - ifTrue: [(value << 1) + 1] - ifFalse: [((16r80000000 + value) << 1) + 1]]! Item was added: + ----- Method: SpurMemoryManager>>integerValueOf: (in category 'immediates') ----- + integerValueOf: oop + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- + isIntegerObject: oop + (#(makeBaseFrameFor: quickFetchInteger:ofObject:) includes: thisContext sender method selector) ifFalse: + [self halt]. + ^(oop bitAnd: 1) ~= 0! Item was changed: ----- Method: StackInterpreter class>>initializeContextIndices (in category 'initialization') ----- initializeContextIndices "Class MethodContext" - | contextFixedSizePlusHeader | SenderIndex := 0. InstructionPointerIndex := 1. StackPointerIndex := 2. MethodIndex := 3. ClosureIndex := 4. "N.B. Called receiverMap in old images, closureOrNil in newer images." ReceiverIndex := 5. CtxtTempFrameStart := 6. + SmallContextSlots := CtxtTempFrameStart + 16. "16 indexable fields" + "Large contexts have 56 indexable fields. Max with single header word of ObjectMemory [but not SpurMemoryManager ;-)]." + LargeContextSlots := CtxtTempFrameStart + 56. + + "Including the header size in these sizes is problematic for multiple memory managers, + so we don't use them, except LargeContextSize for asserts. Set small to nil for error checking." + SmallContextSize := nil. + LargeContextSize := LargeContextSlots + 1 * BytesPerOop. + "Class BlockClosure" ClosureOuterContextIndex := 0. ClosureStartPCIndex := 1. ClosureNumArgsIndex := 2. ClosureFirstCopiedValueIndex := 3. + ClosureCopiedValuesIndex := 3! - ClosureCopiedValuesIndex := 3. - - contextFixedSizePlusHeader := CtxtTempFrameStart + 1. - SmallContextSize := contextFixedSizePlusHeader + 16 * BytesPerWord. "16 indexable fields" - "Large contexts have 56 indexable fields. Max with single header word." - "However note that in 64 bits, for now, large contexts have 3-word headers" - LargeContextSize := contextFixedSizePlusHeader + 56 * BytesPerWord! Item was changed: ----- Method: StackInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') ----- interpreterAllocationReserveBytes "At a rough approximation we may need to allocate up to a couple of page's worth of contexts when switching stack pages, assigning to senders, etc. But the snapshot primitive voids all stack pages. So a safe margin is the size of a large context times the maximum number of frames per page times the number of pages." | maxUsedBytesPerPage maxFramesPerPage | maxUsedBytesPerPage := self stackPageFrameBytes + self stackLimitOffset. maxFramesPerPage := maxUsedBytesPerPage / BytesPerWord // FrameSlots. + ^maxFramesPerPage * LargeContextSlots * BytesPerOop * numStackPages! - ^maxFramesPerPage * LargeContextSize * numStackPages! Item was changed: ----- Method: StackInterpreter>>marryFrame:SP:copyTemps: (in category 'frame access') ----- marryFrame: theFP SP: theSP copyTemps: copyTemps "Marry an unmarried frame. This means creating a spouse context initialized with a subset of the frame's state that references the frame. For the default closure implementation we do not need to copy temps. Different closure implementations may require temps to be copied." + | theContext methodHeader numSlots numArgs numStack closureOrNil numTemps | - | theContext methodHeader byteSize numArgs numStack closureOrNil numTemps | <inline: true> <var: #theFP type: #'char *'> <var: #theSP type: #'char *'> self assert: (self frameHasContext: theFP) not. + "The SP is expected to be pointing at the last oop on the stack, not at the pc" + self assert: (objectMemory addressCouldBeOop: (stackPages longAt: theSP)). + methodHeader := self headerOf: (self frameMethod: theFP). "Decide how much of the stack to preserve in widowed contexts. Preserving too much state will potentially hold onto garbage. Holding onto too little may mean that a dead context isn't informative enough in a debugging situation. If copyTemps is false (as it is in the default closure implementation) compromise, retaining only the arguments with no temporaries. Note that we still set the stack pointer to its current value, but stack contents other than the arguments are nil." numArgs := self frameNumArgs: theFP. numStack := self stackPointerIndexForFrame: theFP WithSP: theSP. closureOrNil := (self frameIsBlockActivation: theFP) ifTrue: [self pushedReceiverOrClosureOfFrame: theFP] ifFalse: [objectMemory nilObject]. + numSlots := (methodHeader bitAnd: LargeContextBit) ~= 0 + ifTrue: [LargeContextSlots] + ifFalse: [SmallContextSlots]. + theContext := objectMemory eeInstantiateMethodContextSlots: numSlots. + self assert: numStack + ReceiverIndex <= numSlots. - byteSize := (methodHeader bitAnd: LargeContextBit) ~= 0 - ifTrue: [LargeContextSize] - ifFalse: [SmallContextSize]. - theContext := objectMemory eeInstantiateMethodContextByteSize: byteSize. - self assert: numStack + ReceiverIndex << ShiftForWord + BaseHeaderSize <= byteSize. "Mark context as married by setting its sender to the frame pointer plus SmallInteger tags and the InstructionPointer to the saved fp (which ensures correct alignment w.r.t. the frame when we check for validity)" objectMemory storePointerUnchecked: SenderIndex ofObject: theContext withValue: (self withSmallIntegerTags: theFP). objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: theContext withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)). objectMemory storePointerUnchecked: StackPointerIndex ofObject: theContext withValue: (objectMemory integerObjectOf: numStack). objectMemory storePointerUnchecked: MethodIndex ofObject: theContext withValue: (self frameMethod: theFP). objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil. objectMemory storePointerUnchecked: ReceiverIndex ofObject: theContext withValue: (self frameReceiver: theFP). "If copyTemps is false, store just the arguments. If the frame is divorced the context will have valid arguments but all temporaries will be nil." 1 to: numArgs do: [:i| objectMemory storePointerUnchecked: ReceiverIndex + i ofObject: theContext "inline self temporary: i - 1 in:theFP" withValue: (stackPages longAt: theFP + FoxCallerSavedIP + ((numArgs - i + 1) * BytesPerWord))]. copyTemps ifTrue: [numTemps := self frameNumTemps: theFP. 1 to: numTemps do: [:i| objectMemory storePointerUnchecked: ReceiverIndex + i + numArgs ofObject: theContext withValue: (self temporary: i - 1 in: theFP)]. numArgs := numArgs + numTemps]. numArgs + 1 to: numStack do: [:i| objectMemory storePointerUnchecked: ReceiverIndex + i ofObject: theContext withValue: objectMemory nilObject]. self setFrameContext: theFP to: theContext. self setFrameHasContext: theFP. self assert: (self frameHasContext: theFP). self assert: (self frameOfMarriedContext: theContext) = theFP. self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext). ^theContext ! Item was changed: ----- Method: StackInterpreter>>primitiveObject:perform:withArguments:lookedUpIn: (in category 'control primitives') ----- primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClass "Common routine used by perform:withArgs:, perform:withArgs:inSuperclass:, object:perform:withArgs:inClass: et al. Answer nil on success. NOTE: The case of doesNotUnderstand: is not a failure to perform. The only failures are arg types and consistency of argumentCount. Since we're in the stack VM we can assume there is space to push the arguments provided they are within limits (max argument count is 15). We can therefore deal with the arbitrary amount of state to remove from the stack (lookup class, selector, mirror receiver) and arbitrary argument orders by deferring popping anything until we know whether the send has succeeded. So on failure we merely have to remove the actual receiver and arguments pushed, and on success we have to slide the actual receiver and arguments down to replace the original ones." | arraySize performArgCount delta | (objectMemory isArray: argumentArray) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. "Check if number of arguments is reasonable; MaxNumArgs isn't available so just use LargeContextSize" arraySize := objectMemory fetchWordLengthOf: argumentArray. + arraySize > LargeContextSlots ifTrue: - arraySize > (LargeContextSize / BytesPerWord) ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs]. performArgCount := argumentCount. "Push newMethod to save it in case of failure, then push the actual receiver and args out of the array." self push: newMethod. self push: actualReceiver. "Copy the arguments to the stack, and execute" 1 to: arraySize do: [:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)]. argumentCount := arraySize. messageSelector := selector. self sendBreak: messageSelector + BaseHeaderSize point: (objectMemory lengthOf: messageSelector) receiver: actualReceiver. self printSends ifTrue: [self printActivationNameForSelector: messageSelector startClass: lookupClass; cr]. self findNewMethodInClass: lookupClass. "Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances" ((objectMemory isOopCompiledMethod: newMethod) and: [(self argumentCountOf: newMethod) ~= argumentCount]) ifTrue: ["Restore the state by popping all those array entries and pushing back the selector and array, and fail" self pop: arraySize + 1. newMethod := self popStack. ^self primitiveFailFor: PrimErrBadNumArgs]. "Cannot fail this primitive from here-on. Slide the actual receiver and arguments down to replace the perform arguments and saved newMethod and then execute the new method. Use argumentCount not arraySize because an MNU may have changed it." delta := BytesPerWord * (performArgCount + 2). "+2 = receiver + saved newMethod" argumentCount * BytesPerWord to: 0 by: BytesPerWord negated do: [:offset| stackPages longAt: stackPointer + offset + delta put: (stackPages longAt: stackPointer + offset)]. self pop: performArgCount + 2. self executeNewMethod. self initPrimCall. "Recursive xeq affects primErrorCode" ^nil! Item was changed: ----- Method: StackInterpreter>>roomToPushNArgs: (in category 'primitive support') ----- roomToPushNArgs: n "Answer if there is room to push n arguments onto the current stack. There may be room in this stackPage but there may not be room if the frame were converted into a context." | cntxSize | self assert: method = (stackPages longAt: framePointer + FoxMethod). cntxSize := ((self headerOf: method) bitAnd: LargeContextBit) ~= 0 + ifTrue: [LargeContextSlots - ReceiverIndex] + ifFalse: [SmallContextSlots - ReceiverIndex]. - ifTrue: [LargeContextSize / BytesPerWord - ReceiverIndex] - ifFalse: [SmallContextSize / BytesPerWord - ReceiverIndex]. ^self stackPointerIndex + n <= cntxSize! Item was changed: ----- Method: StackInterpreter>>transferTo: (in category 'process primitive support') ----- transferTo: newProc "Record a process to be awoken on the next interpreter cycle." | activeContext sched oldProc | <inline: false> statProcessSwitch := statProcessSwitch + 1. self push: instructionPointer. self externalWriteBackHeadFramePointers. self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer. sched := self schedulerPointer. oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched. + activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer + BytesPerWord. - activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext. objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc. objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject. self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc! Item was changed: ----- Method: StackInterpreterPrimitives>>cloneContext: (in category 'primitive support') ----- cloneContext: aContext | sz cloned spouseFP sp | <var: #spouseFP type: #'char *'> + sz := objectMemory numSlotsOf: aContext. + cloned := objectMemory eeInstantiateMethodContextSlots: sz. - sz := (objectMemory byteLengthOf: aContext) + BaseHeaderSize. - cloned := objectMemory eeInstantiateMethodContextByteSize: sz. cloned ~= 0 ifTrue: [0 to: StackPointerIndex do: [:i| objectMemory storePointerUnchecked: i ofObject: cloned withValue: (self externalInstVar: i ofContext: aContext)]. MethodIndex to: ReceiverIndex do: [:i| objectMemory storePointerUnchecked: i ofObject: cloned withValue: (self fetchPointer: i ofObject: aContext)]. (self isStillMarriedContext: aContext) ifTrue: [spouseFP := self frameOfMarriedContext: aContext. sp := (self stackPointerIndexForFrame: spouseFP) - 1. 0 to: sp do: [:i| objectMemory storePointerUnchecked: i + CtxtTempFrameStart ofObject: cloned withValue: (self temporary: i in: spouseFP)]] ifFalse: [sp := (self fetchStackPointerOf: aContext) - 1. 0 to: sp do: [:i| objectMemory storePointerUnchecked: i + CtxtTempFrameStart ofObject: cloned withValue: (self fetchPointer: i + CtxtTempFrameStart ofObject: aContext)]]]. ^cloned! Item was changed: VMBasicConstants subclass: #VMSqueakV3BytecodeConstants instanceVariableNames: '' + classVariableNames: 'CtxtTempFrameStart LargeContextBit LargeContextSize LargeContextSlots SmallContextSize SmallContextSlots' - classVariableNames: 'CtxtTempFrameStart LargeContextBit LargeContextSize SmallContextSize' poolDictionaries: 'VMBasicConstants' category: 'VMMaker-Interpreter'! !VMSqueakV3BytecodeConstants commentStamp: '<historical>' prior: 0! self ensureClassPool. #(CtxtTempFrameStart LargeContextBit LargeContextSize SmallContextSize) do: [:k| self classPool declare: k from: ObjectMemory classPool]!

1 0

VM Maker: Cog-eem.68.mcz
by commits＠source.squeak.org 04 Sep '13

04 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.68.mcz ==================== Summary ==================== Name: Cog-eem.68 Author: eem Time: 3 September 2013, 3:07:33.011 pm UUID: dbc8c75b-6e15-48ce-b17d-e37d1b1a8a96 Ancestors: Cog-eem.67 Fix class indices for LargePosi/NegativeInteger. Fix shift in fillInPointerObject:from:. =============== Diff against Cog-eem.67 =============== Item was changed: ----- Method: SpurBootstrap>>defineKnownClassIndices (in category 'class indices') ----- defineKnownClassIndices "The classTable is laid out - to make it easy to map immediates to classes; the tag pattern of an immediate is its class index. hence there are two entries for SmallInteger - to assign small indices to well-known classes such as Array, Message et al - to leave plenty of room for new known classes; hence the first page contains only well-known classes - to enable overlaps and avoid conflicts with indices in the specialObjectsArray (?really? eem) - to provide a WeakArray pun for the pages of the table itself so that these do not show up as instances of WeakArray" | classMethodContext classBlockClosure classMessage "no api method for these" | classMessage := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMessage) value. classMethodContext := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMethodContext) value. classBlockClosure := oldHeap splObj: (VMObjectIndices bindingOf: #ClassBlockClosure) value. "c.f. CogMemoryManager class>>intializeCompactClassIndices" classToIndex at: oldHeap classSmallInteger put: 1; "N.B. must fill-in index 3 manually" at: oldHeap classCharacter put: 2; "at: oldHeap classSmallInteger put: 3" "N.B. must fill-in index 3 manually" "leave room for up to 15 tagged classes" "leave room for up to 16 puns" + at: oldHeap classLargeNegativeInteger put: 32; + at: oldHeap classLargePositiveInteger put: 33; - at: oldHeap classLargePositiveInteger put: 32; - at: oldHeap classLargeNegativeInteger put: 33; at: oldHeap classFloat put: 34; at: "oldHeap" classMessage put: 35; at: "oldHeap" classMethodContext put: 36; at: "oldHeap" classBlockClosure put: 37; at: oldHeap classSemaphore put: 48; at: oldHeap classMutex put: 49; at: oldHeap classByteArray put: 50; at: oldHeap classArray put: 51; at: oldHeap classString put: 52; at: oldHeap classBitmap put: 53; at: oldHeap classPoint put: 54; at: oldHeap classExternalAddress put: 128; at: oldHeap classExternalData put: 129; at: oldHeap classExternalFunction put: 130; at: oldHeap classExternalLibrary put: 131; at: oldHeap classExternalStructure put: 132; at: oldHeap classAlien put: 133; at: oldHeap classUnsafeAlien put: 133! Item was changed: ----- Method: SpurBootstrap>>fillInPointerObject:from: (in category 'bootstrap') ----- fillInPointerObject: newObj from: oldObj + 0 to: (oldHeap lastPointerOf: oldObj) / oldHeap bytesPerWord - 1 do: - 0 to: (oldHeap lastPointerOf: oldObj) >> 4 - 1 do: [:i| | oldValue newValue | oldValue := oldHeap fetchPointer: i ofObject: oldObj. newValue := (oldHeap isIntegerObject: oldValue) ifTrue: [oldValue] ifFalse: [map at: oldValue ifAbsent: + [oldValue = oldHeap characterTable + ifTrue: [newHeap nilObject] + ifFalse: + [self assert: (oldHeap fetchClassOfNonInt: oldValue) = oldHeap classCharacter. + newHeap characterObjectOf: + (oldHeap integerValueOf: + (oldHeap fetchPointer: CharacterValueIndex ofObject: oldValue))]]]. - [self assert: (oldHeap fetchClassOfNonInt: oldValue) = oldHeap classCharacter. - newHeap characterObjectOf: - (oldHeap integerValueOf: - (oldHeap fetchPointer: CharacterValueIndex ofObject: oldValue))]]. newHeap storePointerUnchecked: i ofObject: newObj withValue: newValue]!

1 0

VM Maker: VMMaker.oscog-eem.345.mcz
by commits＠source.squeak.org 04 Sep '13

04 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.345.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.345 Author: eem Time: 3 September 2013, 3:04:58.943 pm UUID: f2561367-9c5d-4639-826b-6957ffa55c9f Ancestors: VMMaker.oscog-eem.344 Add more protocol to SpurMemoryManager. Bootstrap launch now gets to goodContextSize: in StackInterpreter>>loadInitialContext:. This now needs a change to the base code since Large/SmallContextSize includes baseheaderSize, and SpurMemoryManager baseHeaderSize ~= ObjectMemory baseHeaderSize. Start replacing some is(Non)IntegerObject:'s with is(Non)Immediate:, specifically in StackInterpreter>>isSingleContext:. Make sure all initializeCompactClassIndices initialize all compact class indices ;). =============== Diff against VMMaker.oscog-eem.344 =============== Item was changed: ----- Method: NewspeakInterpreter class>>initializeCompactClassIndices (in category 'initialization') ----- initializeCompactClassIndices "Initialize indices for compact classes we are going to depend on being compact. The VI allows classes to become compact and become uncompact. For efficiency the VM assumes certain classes are compact with particular indices." "Smalltalk compactClassesArray" "{Array. LargePositiveInteger. Float. MethodContext. } collect: [:c| c -> c indexIfCompact]" ClassArrayCompactIndex := 3. ClassLargeNegativeIntegerCompactIndex := 0. "Currently PseudoContext class" ClassLargePositiveIntegerCompactIndex := 5. ClassFloatCompactIndex := 6. + ClassBlockClosureCompactIndex := 0 "12". "Prospective. May still be TranslatedMethod class" - ClassBlockClosureCompactIndex := 0 "12". "Prospective. Currently TranslatedMethod class" ClassByteStringCompactIndex := 11. ClassBlockContextCompactIndex := 13. + ClassMethodContextCompactIndex := 14. + + ClassByteArrayCompactIndex := 0. + ClassMessageCompactIndex := 0. + ClassBitmapCompactIndex := 0! - ClassMethodContextCompactIndex := 14! Item was changed: ----- Method: ObjectMemory class>>initializeCompactClassIndices (in category 'initialization') ----- initializeCompactClassIndices "Initialize indices for compact classes we are going to depend on being compact. The VI allows classes to become compact and become uncompact. For efficiency the VM assumes certain classes are compact with particular indices." "Smalltalk compactClassesArray" "{Array. LargePositiveInteger. Float. MethodContext. } collect: [:c| c -> c indexIfCompact]" ClassArrayCompactIndex := 3. ClassLargeNegativeIntegerCompactIndex := 4. "Was PseudoContext class" ClassLargePositiveIntegerCompactIndex := 5. ClassFloatCompactIndex := 6. + ClassBlockClosureCompactIndex := 0 "12". "Prospective. May still be TranslatedMethod class" - ClassBlockClosureCompactIndex := 0 "12". "Prospective. Currently TranslatedMethod class" ClassByteStringCompactIndex := 11. ClassBlockContextCompactIndex := 13. + ClassMethodContextCompactIndex := 14. + + ClassByteArrayCompactIndex := 0. + ClassMessageCompactIndex := 0. + ClassBitmapCompactIndex := 0! - ClassMethodContextCompactIndex := 14! Item was added: + ----- Method: ObjectMemory>>isImmediate: (in category 'interpreter access') ----- + isImmediate: anOop + ^self isIntegerObject: anOop! Item was added: + ----- Method: ObjectMemory>>isNonImmediate: (in category 'interpreter access') ----- + isNonImmediate: anOop + ^self isNonIntegerObject: anOop! Item was added: + ----- Method: Spur32BitMMLESimulator>>byteAt: (in category 'memory access') ----- + byteAt: byteAddress + | lowBits long | + lowBits := byteAddress bitAnd: 3. + long := self longAt: byteAddress - lowBits. + ^(lowBits caseOf: { + [0] -> [ long ]. + [1] -> [ long bitShift: -8 ]. + [2] -> [ long bitShift: -16 ]. + [3] -> [ long bitShift: -24 ] + }) bitAnd: 16rFF! Item was added: + ----- Method: Spur32BitMemoryManager>>isNonImmediate: (in category 'object testing') ----- + isNonImmediate: oop + ^(oop bitAnd: 3) = 0! Item was added: + ----- Method: Spur64BitMemoryManager>>isNonImmediate: (in category 'object testing') ----- + isNonImmediate: oop + ^(oop bitAnd: 7) = 0! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was changed: ----- Method: SpurMemoryManager class>>initializeCompactClassIndices (in category 'class initialization') ----- initializeCompactClassIndices "Reuse the compact class indices to name known classIndices. This helps reduce the churn in the interpreters." "c.f. SpurBootstrap>>defineKnownClassIndices" ClassLargeNegativeIntegerCompactIndex := 32. ClassLargePositiveIntegerCompactIndex := 33. ClassFloatCompactIndex := 34. ClassMessageCompactIndex := 35. ClassMethodContextCompactIndex := 36. + ClassBlockContextCompactIndex := 0. ClassBlockClosureCompactIndex := 37. ClassByteArrayCompactIndex := 50. ClassArrayCompactIndex := 51. ClassByteStringCompactIndex := 52. ClassBitmapCompactIndex := 53! Item was changed: ----- Method: SpurMemoryManager>>classAtIndex: (in category 'class table') ----- classAtIndex: classIndex + | classTablePage | + classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift + ofObject: classTableRootObj. + ^self + fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask) + ofObject: classTablePage! - | majorIndex minorIndex page | - majorIndex := classIndex >> self classTableMajorIndexShift. - minorIndex := classIndex bitAnd: self classTableMinorIndexMask. - self assert: (majorIndex between: 0 and: (self numSlotsOf: classTableRootObj) - 1). - page := self fetchPointer: majorIndex ofObject: classTableRootObj. - ^self fetchPointer: minorIndex ofObject: page! Item was added: + ----- Method: SpurMemoryManager>>compactIndexOfClass: (in category 'class membership') ----- + compactIndexOfClass: objOop + ^self hashBitsOf: objOop! Item was added: + ----- Method: SpurMemoryManager>>fetchClassOfNonInt: (in category 'object access') ----- + fetchClassOfNonInt: objOop + | classIndex | + classIndex := self classIndexOf: objOop. + ^self classAtIndex: classIndex! Item was added: + ----- Method: SpurMemoryManager>>firstByteFormat (in category 'header format') ----- + firstByteFormat + ^16! Item was added: + ----- Method: SpurMemoryManager>>firstFixedField: (in category 'object access') ----- + firstFixedField: objOop + <returnTypeC: #'void *'> + ^ self pointerForOop: objOop + self baseHeaderSize! Item was added: + ----- Method: SpurMemoryManager>>firstLongFormat (in category 'header format') ----- + firstLongFormat + ^10! Item was added: + ----- Method: SpurMemoryManager>>firstShortFormat (in category 'header format') ----- + firstShortFormat + ^12! Item was changed: ----- Method: SpurMemoryManager>>formatMask (in category 'header format') ----- formatMask + "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,7,8 unused + 9 (?) 64-bit indexable + 10 - 11 32-bit indexable + 12 - 15 16-bit indexable + 16 - 23 byte indexable + 24 - 31 compiled method" ^16r1f! Item was added: + ----- Method: SpurMemoryManager>>hashBitsOf: (in category 'header access') ----- + hashBitsOf: objOop + self flag: #endianness. + ^(self longAt: objOop) bitAnd: self identityHashHalfWordMask! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize + freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0). + checkForLeaks := 0. + needGCFlag := false. + heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]! - freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0)! Item was added: + ----- Method: SpurMemoryManager>>isBytes: (in category 'object testing') ----- + isBytes: oop + "Answer true if the argument contains indexable bytes. See comment in formatOf:" + "Note: Includes CompiledMethods." + ^(self isNonImmediate: oop) and: [self isBytesNonImm: oop]! Item was added: + ----- Method: SpurMemoryManager>>isBytesNonImm: (in category 'object testing') ----- + isBytesNonImm: objOop + "Answer true if the argument contains indexable bytes. See comment in formatOf:" + ^(self formatOf: objOop) >= self firstByteFormat! Item was added: + ----- Method: SpurMemoryManager>>isNonImmediate: (in category 'object testing') ----- + isNonImmediate: oop + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>leakCheckFullGC (in category 'debug support') ----- + leakCheckFullGC + <api> + ^(checkForLeaks bitAnd: 1) ~= 0! Item was added: + ----- Method: SpurMemoryManager>>lengthOf: (in category 'object access') ----- + lengthOf: objOop + "Answer the number of indexable bytes or words in the given object. + For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result." + + <api> + | header | + <var: #header type: #usqLong> + <inline: true> + <asmLabel: false> + header := self baseHeader: objOop. + ^self lengthOf: objOop baseHeader: header format: (self formatOfHeader: header)! Item was added: + ----- Method: SpurMemoryManager>>lengthOf:baseHeader:format: (in category 'object access') ----- + lengthOf: objOop baseHeader: header format: fmt + <var: #header type: #usqLong> + "Compatibility; does not really suit the Spur format. + Answer the number of indexable bytes or words in the given object. + For a CompiledMethod, the size of the method header (in bytes) should + be subtracted from the result of this method." + | numSlots | + <inline: true> + <asmLabel: false> + numSlots := self numSlotsOf: objOop. + fmt <= self sixtyFourBitIndexableFormat ifTrue: + [^numSlots]. + fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod" + [^numSlots << self shiftForWord - (fmt bitAnd: 7)]. + fmt >= self firstShortFormat ifTrue: + [^numSlots << (self shiftForWord - 1) - (fmt bitAnd: 3)]. + "fmt >= self firstLongFormat" + ^numSlots << (self shiftForWord - 1) - (fmt bitAnd: 1)! Item was added: + ----- Method: SpurMemoryManager>>sixtyFourBitIndexableFormat (in category 'header format') ----- + sixtyFourBitIndexableFormat + ^9! Item was added: + ----- Method: SpurMemoryManager>>sizeBitsOf: (in category 'object access') ----- + sizeBitsOf: objOop + "Answer the number of bytes in the given object, including its base header, rounded up to an integral number of words. + Hence, were it not for the fact that zero-sized objects have at least room for a forwarding pointer, + objOop + (self sizeBitsOf: objOop) is the address immediately following objOop." + "Note: byte indexable objects need to have low bits subtracted from this size to find the address beyond the last byte." + ^(self numSlotsOf: objOop) << self shiftForWord + self baseHeaderSize! Item was changed: ----- Method: StackInterpreter>>isSingleContext: (in category 'frame access') ----- isSingleContext: aContext + ^objectMemory isNonImmediate: (objectMemory fetchPointer: SenderIndex ofObject: aContext)! - ^objectMemory isNonIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)!

1 0

VM Maker: Cog-eem.67.mcz
by commits＠source.squeak.org 03 Sep '13

03 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.67.mcz ==================== Summary ==================== Name: Cog-eem.67 Author: eem Time: 3 September 2013, 1:53:20.082 pm UUID: 3b61b127-9705-4da9-8caf-81f65a35418b Ancestors: Cog-eem.66 Simplify Spur bootstrap launch given VMMaker.oscog-eem.344. Fix MultiProcessor after the refactoring of the processor Aliens given the addition of the ARM processor alien. =============== Diff against Cog-eem.66 =============== Item was changed: ----- Method: MultiProcessor>>processor: (in category 'initialize-release') ----- processor: aProcessor processor := aProcessor. + guardedProcessorProtocol := aProcessor class selectors asSet + addAll: aProcessor class superclass selectors; + yourself. - guardedProcessorProtocol := aProcessor class selectors asSet. unguardedProcessorProtocol := #(#'Cog API' #opcodes #disassembly #printing) inject: Set new into: [ :protocol :category| protocol addAll: (aProcessor class organization listAtCategoryNamed: category); + addAll: (aProcessor class superclass organization listAtCategoryNamed: category); yourself]. guardedProcessorProtocol removeAll: unguardedProcessorProtocol! Item was changed: ----- Method: SpurBootstrap>>launch (in category 'testing') ----- launch | sim | + sim := StackInterpreterSimulator onObjectMemory: newHeap. - SpurMemoryManager initializeWithOptions: Dictionary new. - sim := StackInterpreterSimulator new. - sim instVarNamed: #objectMemory put: newHeap. newHeap coInterpreter: sim. newHeap initializePostBootstrap. sim initializeInterpreter: 0. sim run!

1 0

VM Maker: VMMaker.oscog-eem.344.mcz
by commits＠source.squeak.org 03 Sep '13

03 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.344.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.344 Author: eem Time: 3 September 2013, 1:50:17.78 pm UUID: 9e4df594-7952-4318-aaa8-a088bbc78de0 Ancestors: VMMaker.oscog-eem.343 Move all the tortured class initialization logic from the simulators' initialize methods to the simulators' instance creation methods. Spur bootstrap now correctly initializaes the compact class indices with those for SpurMemoryManager, not NewObjectMemory. Add a little more protocol to SpurMemoryManager. Fix comment typo. =============== Diff against VMMaker.oscog-eem.343 =============== Item was changed: CoInterpreterMT subclass: #CogVMSimulator instanceVariableNames: 'enableCog byteCount lastPollCount lastExtPC sendCount printSends traceOn myBitBlt displayForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-JITSimulation'! + !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0! - !CogVMSimulator commentStamp: 'eem 2/13/2013 15:33' prior: 0! This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. Remember that you can test the Cogit using its class-side in-image compilation facilities. To see the thing actually run, you could (after backing up this image and changes), execute (CogVMSimulator new openOn: Smalltalk imageName) test and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. Here's an example to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff: + (CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit)) - | opts | - CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)). - CogVMSimulator chooseAndInitCogitClassWithOpts: opts. - CogVMSimulator new desiredNumStackPages: 8; + openOn: '/Users/eliot/Cog/startreader.image'; openAsMorph; run Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out. | cos proc opts | CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)). CogVMSimulator chooseAndInitCogitClassWithOpts: opts. cos := CogVMSimulator new. "cos initializeThreadSupport." "to test the multi-threaded VM" cos desiredNumStackPages: 8. "to set the size of the stack zone" "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone" cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image" "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector" proc := cos cogit processor. "cos cogit sendTrace: 7." "turn on tracing" "set a complex breakpoint at a specific point in machine code" "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg| cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1". "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit" "cos cogit setBreakMethod: 16rB38880." cos openAsMorph; "toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window" halt; run! Item was added: + ----- Method: CogVMSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') ----- + initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil + "The relevant ObjectMemory, Interpreter and Cogit classes must be initialized in order. + This happens notionally every time we start the simulator, + but in fact happens when ever we instantiate a simulator." + | optionsDictionary cogitClassOrName | + optionsDictionary := optionsDictionaryOrArray isArray + ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray] + ifFalse: [optionsDictionaryOrArray]. + (objectMemoryClassOrNil ifNil: [self objectMemoryClass]) + initializeWithOptions: optionsDictionary. + + ((optionsDictionary at: #COGMTVM ifAbsent: [false]) + ifTrue: [CoInterpreterMT] + ifFalse: [CoInterpreter]) + initializeWithOptions: optionsDictionary. + + (optionsDictionary includesKey: #Cogit) ifTrue: + [cogitClassOrName := optionsDictionary at: #Cogit. + cogitClassOrName isSymbol ifTrue: + [cogitClassOrName := Smalltalk classNamed: cogitClassOrName]. + CoInterpreter classPool at: #CogitClass put: cogitClassOrName]. + + (self cogitClass withAllSuperclasses copyUpTo: Cogit) reverseDo: + [:c| c initializeWithOptions: optionsDictionary]! Item was changed: ----- Method: CogVMSimulator class>>new (in category 'instance creation') ----- new + ^self onObjectMemory: nil cogit: nil options: #()! - ^self == CogVMSimulator - ifTrue: [SmalltalkImage current endianness == #big - ifTrue: [self notYetImplemented] - ifFalse: [CogVMSimulatorLSB new]] - ifFalse: [super new]! Item was added: + ----- Method: CogVMSimulator class>>newWithOptions: (in category 'instance creation') ----- + newWithOptions: optionsDictionaryOrArray + ^self onObjectMemory: nil cogit: nil options: optionsDictionaryOrArray! Item was added: + ----- Method: CogVMSimulator class>>onObjectMemory: (in category 'instance creation') ----- + onObjectMemory: anObjectMemory + ^self onObjectMemory: anObjectMemory cogit: nil options: #()! Item was added: + ----- Method: CogVMSimulator class>>onObjectMemory:cogit: (in category 'instance creation') ----- + onObjectMemory: anObjectMemory cogit: aCogit + ^self onObjectMemory: anObjectMemory cogit: aCogit options: #()! Item was added: + ----- Method: CogVMSimulator class>>onObjectMemory:cogit:options: (in category 'instance creation') ----- + onObjectMemory: anObjectMemory cogit: aCogit options: optionsDictionaryOrArray + ^self == CogVMSimulator + ifTrue: + [self initializeWithOptions: optionsDictionaryOrArray + objectMemoryClass: (anObjectMemory ifNotNil: [anObjectMemory class]). + SmalltalkImage current endianness == #big + ifTrue: [self notYetImplemented] + ifFalse: [CogVMSimulatorLSB onObjectMemory: anObjectMemory cogit: aCogit options: optionsDictionaryOrArray]] + ifFalse: + [| sim | + sim := self basicNew. + sim objectMemory: anObjectMemory. + sim cogit: aCogit. + sim initialize. + COGMTVM ifTrue: "Set via options" + [sim initializeThreadSupport; initialize]. + sim]! Item was changed: ----- Method: CogVMSimulator>>initialize (in category 'initialization') ----- initialize + "Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The + primary responsibility of this method is to allocate Smalltalk Arrays for variables + that will be declared as statically-allocated global arrays in the translated code." - "Initialize the StackInterpreterSimulator when running the interpreter - inside Smalltalk. The primary responsibility of this method is to allocate - Smalltalk Arrays for variables that will be declared as statically-allocated - global arrays in the translated code." + objectMemory ifNil: + [objectMemory := self class objectMemoryClass simulatorClass new]. + cogit ifNil: + [cogit := self class cogitClass new setInterpreter: self]. + objectMemory coInterpreter: self cogit: cogit. - | objectMemoryClass | - "initialize class variables" - objectMemory ifNotNil: - [^self halt]. - - objectMemoryClass := self class objectMemoryClass. - - objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord. - ((Smalltalk classNamed: #CoInterpreterMT) ifNil: [CoInterpreter] ifNotNil: [:cimt| cimt]) initialize. - (self class cogitClass withAllSuperclasses copyUpThrough: Cogit) reverseDo: - [:c| c initialize]. - - super initialize. - objectMemory := objectMemoryClass simulatorClass new. - cogit := self class cogitClass new setInterpreter: self. cogit numRegArgs > 0 ifTrue: [debugStackDepthDictionary := Dictionary new]. - objectMemory coInterpreter: self cogit: cogit. + cogThreadManager ifNotNil: + [super initialize]. + "Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently for simulation, due to the fact that the simulator works only with +ve 32-bit values" ConstMinusOne := objectMemory integerObjectOf: -1. HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1. cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())" enableCog := true. methodCache := Array new: MethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. self flushAtCache. cogCompiledCodeCompactionCalledFor := false. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. pluginList := #(). mappedPluginEntries := OrderedCollection new. desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := Time totalSeconds * 1000000. maxLiteralCountForCompile := MaxLiteralCountForCompile. minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile. flagInterpretedMethods := false. "initialize InterpreterSimulator variables used for debugging" byteCount := lastPollCount := sendCount := 0. quitBlock := [^ self]. traceOn := true. printSends := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. transcript := Transcript. displayForm := 'Display has not yet been installed' asDisplayText form. suppressHeartbeatFlag := deferSmash := deferredSmash := false. systemAttributes := Dictionary new. primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0). primTraceLogIndex := 0. traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0). traceLogIndex := 0. traceSources := TraceSources. statCodeCompactionCount := 0. statCodeCompactionUsecs := 0. extSemTabSize := 256! Item was changed: ----- Method: InterpreterSimulator>>initialize (in category 'initialization') ----- initialize - "Initialize the InterpreterSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." - "initialize class variables" - ObjectMemory initBytesPerWord: self bytesPerWord. - ObjectMemory initialize. - Interpreter initialize. - "Note: we must initialize ConstMinusOne differently for simulation, due to the fact that the simulator works only with +ve 32-bit values" ConstMinusOne := self integerObjectOf: -1. methodCache := Array new: MethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. rootTable := Array new: RootTableSize. weakRoots := Array new: RootTableSize + RemapBufferSize + 100. remapBuffer := Array new: RemapBufferSize. gcSemaphoreIndex := 0. semaphoresUseBufferA := true. semaphoresToSignalA := Array new: SemaphoresToSignalSize. semaphoresToSignalB := Array new: SemaphoresToSignalSize. externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). primitiveTable := self class primitiveTable. pluginList := #(). mappedPluginEntries := #(). "initialize InterpreterSimulator variables used for debugging" byteCount := 0. sendCount := 0. quitBlock := [^ self]. traceOn := true. printSends := "printReturns := printBytecodeAtEachStep :=" false. myBitBlt := BitBltSimulator new setInterpreter: self. headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes. transcript := Transcript. displayForm := 'Display has not yet been installed' asDisplayText form. ! Item was changed: ----- Method: ObjectMemory>>integerObjectOf: (in category 'interpreter access') ----- integerObjectOf: value "Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object. In C, use a shift and an add to set the tag bit. + In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns." - In Smalltalk we have to work harder because thesimulator works with strictly positive bit patterns." ^self cCode: [(value << 1) + 1] inSmalltalk: [value >= 0 ifTrue: [(value << 1) + 1] ifFalse: [((16r80000000 + value) << 1) + 1]]! Item was added: + ----- Method: Spur32BitMemoryManager class>>bytesPerWord (in category 'word size') ----- + bytesPerWord + ^4! Item was added: + ----- Method: Spur64BitMemoryManager class>>bytesPerWord (in category 'word size') ----- + bytesPerWord + ^8! Item was added: + ----- Method: SpurMemoryManager class>>bytesPerWord (in category 'word size') ----- + bytesPerWord + ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager class>>initializeWithOptions: (in category 'class initialization') ----- initializeWithOptions: optionsDictionary "SpurMemoryManager initializeWithOptions: Dictionary new" + self initBytesPerWord: (self == SpurMemoryManager + ifTrue: [optionsDictionary at: #BytesPerWord ifAbsent: [4]] + ifFalse: [self bytesPerWord]). - self initBytesPerWord: (optionsDictionary at: #BytesPerWord ifAbsent: [4]). BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord]. self initializeSpecialObjectIndices. self initializeCompactClassIndices. self initializePrimitiveErrorCodes.! Item was added: + ----- Method: SpurMemoryManager>>integerObjectOf: (in category 'immediates') ----- + integerObjectOf: value + "Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object. + In C, use a shift and an add to set the tag bit. + In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns." + + ^self + cCode: [(value << 1) + 1] + inSmalltalk: [value >= 0 + ifTrue: [(value << 1) + 1] + ifFalse: [((16r80000000 + value) << 1) + 1]]! Item was changed: ----- Method: StackInterpreter class>>initializeWithOptions: (in category 'initialization') ----- initializeWithOptions: optionsDictionary "StackInterpreter initializeWithOptions: Dictionary new" - NewObjectMemory initializeWithOptions: optionsDictionary. "initialize ObjectMemory constants" self initializeMiscConstantsWith: optionsDictionary. "must preceed other initialization." self initializeAssociationIndex. self initializeBytecodeTable. self initializeCaches. self initializeCharacterIndex. self initializeCharacterScannerIndices. self initializeClassIndices. self initializeContextIndices. self initializeDirectoryLookupResultCodes. self initializeFrameIndices. self initializeMessageIndices. self initializeMethodIndices. self initializePointIndices. self initializePrimitiveTable. self initializeSchedulerIndices. self initializeSmallIntegers. self initializeStreamIndices! Item was added: + ----- Method: StackInterpreter>>objectMemory: (in category 'initialization') ----- + objectMemory: anObjectMemory + <doNotGenerate> + objectMemory := anObjectMemory! Item was changed: StackInterpreterPrimitives subclass: #StackInterpreterSimulator instanceVariableNames: 'byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-InterpreterSimulation'! + !StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0! - !StackInterpreterSimulator commentStamp: 'eem 2/13/2013 15:23' prior: 0! This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. To see the thing actually run, you could (after backing up this image and changes), execute (StackInterpreterSimulator new openOn: Smalltalk imageName) test + ((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true)) + openOn: 'ns101.image') test + and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. Here's an example of what Eliot uses to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff: | vm | + vm := StackInterpreterSimulator newWithOptions: #(). - StackInterpreter initializeWithOptions: (Dictionary newFromPairs: #()). - vm := StackInterpreterSimulator new. vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. vm setBreakSelector: #&. vm openAsMorph; run! Item was added: + ----- Method: StackInterpreterSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') ----- + initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil + "The relevant ObjectMemory and Interpreter classes must be initialized in order. + This happens notionally every time we start the simulator, + but in fact happens when ever we instantiate a simulator." + | optionsDictionary | + optionsDictionary := optionsDictionaryOrArray isArray + ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray] + ifFalse: [optionsDictionaryOrArray]. + (objectMemoryClassOrNil ifNil: [self objectMemoryClass]) + initializeWithOptions: optionsDictionary. + + StackInterpreter initializeWithOptions: optionsDictionary! Item was changed: ----- Method: StackInterpreterSimulator class>>new (in category 'instance creation') ----- new + ^self onObjectMemory: nil options: #()! - ^ self == StackInterpreterSimulator - ifTrue: [SmalltalkImage current endianness == #big - ifTrue: [self notYetImplemented"StackInterpreterSimulatorMSB new"] - ifFalse: [StackInterpreterSimulatorLSB new]] - ifFalse: [super new]! Item was added: + ----- Method: StackInterpreterSimulator class>>newWithOptions: (in category 'instance creation') ----- + newWithOptions: optionsDictionaryOrArray + ^self onObjectMemory: nil options: optionsDictionaryOrArray! Item was added: + ----- Method: StackInterpreterSimulator class>>onObjectMemory: (in category 'instance creation') ----- + onObjectMemory: anObjectMemory + ^self onObjectMemory: anObjectMemory options: #()! Item was added: + ----- Method: StackInterpreterSimulator class>>onObjectMemory:options: (in category 'instance creation') ----- + onObjectMemory: anObjectMemory options: optionsDictionaryOrArray + ^self == StackInterpreterSimulator + ifTrue: + [self initializeWithOptions: optionsDictionaryOrArray + objectMemoryClass: (anObjectMemory ifNotNil: [anObjectMemory class]). + SmalltalkImage current endianness == #big + ifTrue: [self notYetImplemented"StackInterpreterSimulatorMSB onObjectMemory: anObjectMemory"] + ifFalse: [StackInterpreterSimulatorLSB onObjectMemory: anObjectMemory]] + ifFalse: [super basicNew objectMemory: anObjectMemory; initialize]! Item was changed: ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') ----- initialize "Initialize the StackInterpreterSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." + objectMemory ifNil: + [objectMemory := self class objectMemoryClass simulatorClass new]. - | objectMemoryClass | - - "initialize class variables" - objectMemory ifNotNil: - [^self halt]. - - objectMemoryClass := self class objectMemoryClass. - - objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord. - objectMemoryClass initialize. - StackInterpreter initialize. - - super initialize. - objectMemory := objectMemoryClass simulatorClass new. objectMemory coInterpreter: self. "Note: we must initialize ConstMinusOne differently for simulation, due to the fact that the simulator works only with +ve 32-bit values" ConstMinusOne := objectMemory integerObjectOf: -1. methodCache := Array new: MethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. self flushAtCache. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. pluginList := #(). mappedPluginEntries := #(). desiredNumStackPages := desiredEdenBytes := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := Time totalSeconds * 1000000. "initialize InterpreterSimulator variables used for debugging" byteCount := 0. sendCount := 0. quitBlock := [^ self]. traceOn := true. printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. transcript := Transcript. displayForm := 'Display has not yet been installed' asDisplayText form. suppressHeartbeatFlag := false. extSemTabSize := 256. disableBooleanCheat := false!

1 0

VM Maker: Cog-eem.66.mcz
by commits＠source.squeak.org 03 Sep '13

03 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.66.mcz ==================== Summary ==================== Name: Cog-eem.66 Author: eem Time: 2 September 2013, 6:23:37.336 pm UUID: 66744cc4-36ff-4638-847f-f7fdfc4c08ef Ancestors: Cog-eem.65 Rename CogMemoryManager et al to SpurMemoryManager et al. Add class initialization of SpurMemoryManager. Move assignment of classTableRootObj: so SMM can cache classTableFirstPage. Add comment to defineKnownClassIndices to ref mirror init in SMM class. =============== Diff against Cog-eem.65 =============== Item was changed: ----- Method: SpurBootstrap>>allocateClassTable (in category 'bootstrap') ----- allocateClassTable "Allocate the root of the classTable plus enough pages to accomodate all classes in the classToIndex map. Don;t fill in the entries yet; the classes have yet to be cloned." | tableRootSize tableRoot page maxSize numPages | tableRootSize := self classTableSize / newHeap classTablePageSize. tableRoot := newHeap allocateSlots: tableRootSize format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. self assert: (newHeap numSlotsOf: tableRoot) = tableRootSize. self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat. self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun. - newHeap classTableRootObj: tableRoot. newHeap nilFieldsOf: tableRoot. "first page is strong" page := newHeap allocateSlots: newHeap classTablePageSize format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize. self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat. self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun. self assert: (newHeap objectAfter: tableRoot) = page. newHeap nilFieldsOf: page. newHeap storePointer: 0 ofObject: tableRoot withValue: page. + newHeap classTableRootObj: tableRoot. maxSize := classToIndex inject: 0 into: [:a :b| a max: b]. numPages := (maxSize + newHeap classTableMinorIndexMask / newHeap classTablePageSize) truncated. 2 to: numPages do: [:i| page := newHeap allocateSlots: newHeap classTablePageSize format: newHeap weakArrayFormat classIndex: newHeap weakArrayClassIndexPun. self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize. self assert: (newHeap formatOf: page) = newHeap weakArrayFormat. self assert: (newHeap classIndexOf: page) = newHeap weakArrayClassIndexPun. newHeap nilFieldsOf: page. newHeap storePointer: i - 1 ofObject: tableRoot withValue: page. self assert: (newHeap objectAfter: (newHeap fetchPointer: i - 2 ofObject: tableRoot)) = page]. pastClassTable := newHeap freeStart.! Item was changed: ----- Method: SpurBootstrap>>defineKnownClassIndices (in category 'class indices') ----- defineKnownClassIndices "The classTable is laid out - to make it easy to map immediates to classes; the tag pattern of an immediate is its class index. hence there are two entries for SmallInteger - to assign small indices to well-known classes such as Array, Message et al - to leave plenty of room for new known classes; hence the first page contains only well-known classes - to enable overlaps and avoid conflicts with indices in the specialObjectsArray (?really? eem) - to provide a WeakArray pun for the pages of the table itself so that these do not show up as instances of WeakArray" | classMethodContext classBlockClosure classMessage "no api method for these" | classMessage := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMessage) value. classMethodContext := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMethodContext) value. classBlockClosure := oldHeap splObj: (VMObjectIndices bindingOf: #ClassBlockClosure) value. + "c.f. CogMemoryManager class>>intializeCompactClassIndices" classToIndex at: oldHeap classSmallInteger put: 1; "N.B. must fill-in index 3 manually" at: oldHeap classCharacter put: 2; "at: oldHeap classSmallInteger put: 3" "N.B. must fill-in index 3 manually" "leave room for up to 15 tagged classes" "leave room for up to 16 puns" at: oldHeap classLargePositiveInteger put: 32; at: oldHeap classLargeNegativeInteger put: 33; at: oldHeap classFloat put: 34; at: "oldHeap" classMessage put: 35; at: "oldHeap" classMethodContext put: 36; at: "oldHeap" classBlockClosure put: 37; at: oldHeap classSemaphore put: 48; at: oldHeap classMutex put: 49; at: oldHeap classByteArray put: 50; at: oldHeap classArray put: 51; at: oldHeap classString put: 52; at: oldHeap classBitmap put: 53; at: oldHeap classPoint put: 54; at: oldHeap classExternalAddress put: 128; at: oldHeap classExternalData put: 129; at: oldHeap classExternalFunction put: 130; at: oldHeap classExternalLibrary put: 131; at: oldHeap classExternalStructure put: 132; at: oldHeap classAlien put: 133; at: oldHeap classUnsafeAlien put: 133! Item was changed: ----- Method: SpurBootstrap>>launch (in category 'testing') ----- launch | sim | + SpurMemoryManager initializeWithOptions: Dictionary new. sim := StackInterpreterSimulator new. sim instVarNamed: #objectMemory put: newHeap. newHeap coInterpreter: sim. newHeap initializePostBootstrap. sim initializeInterpreter: 0. sim run! Item was changed: ----- Method: SpurBootstrap>>on: (in category 'initialize-release') ----- on: imageName StackInterpreter initializeWithOptions: Dictionary new. oldInterpreter := StackInterpreterSimulator new. oldInterpreter openOn: imageName extraMemory: 0. oldHeap := oldInterpreter objectMemory. + newHeap := Spur32BitMMLESimulator new. - newHeap := CMM32LSBSimulator new. newHeap allocateMemoryOfSize: (oldHeap youngStart * 5 / 4 roundUpTo: 8) newSpaceSize: 1024 * 1024 codeSize: 1024 * 1024. map := Dictionary new: oldHeap memory size // 4. reverseMap := Dictionary new: oldHeap memory size // 4. classToIndex := Dictionary new: 1024!

1 0

VM Maker: VMMaker.oscog-eem.343.mcz
by commits＠source.squeak.org 03 Sep '13

03 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.343.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.343 Author: eem Time: 2 September 2013, 6:20:44.476 pm UUID: 6f6c27c0-0b82-465c-8748-de54cdacc724 Ancestors: VMMaker.oscog-eem.342 Rename CogMemoryManager et al to SpurMemoryManager et al. Move the compact class indices to VMSqueakClassIndices from VMSqueakV3ObjectRepresentationConstants. Move initializePrimitiveErrorCodes up to VMClass. Add some class-side initialzation to SpurMemoryManager. Bootstrap gets as far as StackInterpreter initialization where it stumbles over the static objectMemoryClass initialization in StackInterpreter>>initializeInterpreter:. This must be rethought. =============== Diff against VMMaker.oscog-eem.342 =============== Item was removed: - CogMemoryManager32Bits subclass: #CMM32LSBSimulator - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-MemoryManagerSimulation'! Item was removed: - ----- Method: CMM32LSBSimulator>>endianness (in category 'memory access') ----- - endianness - ^#little! Item was removed: - ----- Method: CMM32LSBSimulator>>headerForSlots:format:classIndex: (in category 'header format') ----- - headerForSlots: numSlots format: formatField classIndex: classIndex - "The header format in LSB is - MSB: | 2 bits | - | 22: identityHash | - | 8: slotSize | - | 3 bits | - | 5: format | - | 2 bits | - | 22: classIndex | : LSB" - self assert: (numSlots between: 0 and: self numSlotsMask). - self assert: (formatField between: 0 and: 31). - self assert: (classIndex between: 0 and: 16r3fffff). - ^super headerForSlots: numSlots format: formatField classIndex: classIndex! Item was removed: - ----- Method: CMM32LSBSimulator>>long32At:put: (in category 'memory access') ----- - long32At: byteAddress put: a32BitValue - "Store the 32-bit value at byteAddress which must be 0 mod 4." - - ^self longAt: byteAddress put: a32BitValue! Item was removed: - ----- Method: CMM32LSBSimulator>>longAt: (in category 'memory access') ----- - longAt: byteAddress - "Note: Adjusted for Smalltalk's 1-based array indexing." - byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. - ^memory at: byteAddress // 4 + 1! Item was removed: - ----- Method: CMM32LSBSimulator>>longAt:put: (in category 'memory access') ----- - longAt: byteAddress put: a32BitValue - "Note: Adjusted for Smalltalk's 1-based array indexing." - byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. - ^memory at: byteAddress // 4 + 1 put: a32BitValue! Item was removed: - ----- Method: CMM32LSBSimulator>>longLongAt: (in category 'memory access') ----- - longLongAt: byteAddress - "memory is a Bitmap, a 32-bit indexable array of bits" - | hiWord loWord | - byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. - loWord := memory at: byteAddress // 4 + 1. - hiWord := memory at: byteAddress // 4 + 2. - ^hiWord = 0 - ifTrue: [loWord] - ifFalse: [(hiWord bitShift: 32) + loWord]! Item was removed: - ----- Method: CMM32LSBSimulator>>longLongAt:put: (in category 'memory access') ----- - longLongAt: byteAddress put: a64BitValue - "memory is a Bitmap, a 32-bit indexable array of bits" - byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. - memory - at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff); - at: byteAddress // 4 + 2 put: a64BitValue >> 32. - ^a64BitValue! Item was removed: - ----- Method: CMM32LSBSimulator>>unalignedAccessError (in category 'memory access') ----- - unalignedAccessError - ^self error: 'unaligned access'! Item was removed: - VMClass subclass: #CogGenerationScavenger - instanceVariableNames: 'coInterpreter manager memory futureSpace pastSpace rememberedSet rememberedSetSize' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-MemoryManager'! Item was removed: - ----- Method: CogGenerationScavenger>>copyAndForward: (in category 'api') ----- - copyAndForward: survivor - "copyAndForward: survivor copies a survivor object either to - futureSurvivorSpace or, if it is to be promoted, to oldSpace. - It leaves a forwarding pointer behind." - <var: #survivor type: #'object *'> - | newLocation | - newLocation := (self shouldBeTenured: survivor) - ifTrue: [self copyToOldSpace: survivor] - ifFalse: [self copyToFutureSpace: survivor]. - manager forward: survivor to: newLocation - ! Item was removed: - ----- Method: CogGenerationScavenger>>scavenge (in category 'api') ----- - scavenge - "The main routine, scavenge, scavenges young objects reachable from the roots (the stack zone - and the rememberedTable). It first scavenges the new objects immediately reachable from the - stack zone, then those directly from old ones (all in the remembered table). Then it scavenges - those that are transitively reachable. If this results in a promotion, the promotee gets remembered, - and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from - the promoted. This loop continues until no more reachable objects are left. At that point, - pastSurvivorSpace is exchanged with futureSurvivorSpace. - - Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize - and previousFutureSurvivorSpaceSize variables ensure that no object is scanned twice, as well as - detecting closure. If this were not true, some pointers might get forwarded twice." - - coInterpreter scavengeStacks. - self scavengeLoop. - self exchange: pastSpace with: futureSpace! Item was removed: - ----- Method: CogGenerationScavenger>>scavengeFutureSurvivorSpaceStartingAt: (in category 'api') ----- - scavengeFutureSurvivorSpaceStartingAt: initialAddress - "scavengeFutureSurvivorSpaceStartingAt: does a depth-first traversal of the - new objects starting at the one at the nth word of futureSurvivorSpace." - | ptr | - <var: #ptr type: #'char *'> - ptr := initialAddress. - [ptr < futureSpace limit] whileTrue: - [| obj | - obj := manager objectAt: ptr. - ptr := ptr + (manager byteLengthOf: obj). - self cCoerceSimple: (self scavengeReferentsOf: obj) - to: #void]! Item was removed: - ----- Method: CogGenerationScavenger>>scavengeLoop (in category 'api') ----- - scavengeLoop - "This is the inner loop of the main routine, scavenge. It first scavenges the new objects immediately - reachable from old ones. Then it scavenges those that are transitively reachable. If this results in a - promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee, - then scavenges the ones reachable from the promoted. This loop continues until no more reachable - objects are left. At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace. - - Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize - and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as - detecting closure. If this were not true, some pointers might get forwarded twice." - - | previousRememberedSetSize previousFutureSurvivorSpaceLimit | - previousRememberedSetSize := 0. - previousFutureSurvivorSpaceLimit := futureSpace limit. - self assert: futureSpace limit = futureSpace start. - [self scavengeRememberedSetStartingAt: previousRememberedSetSize. - previousFutureSurvivorSpaceLimit = futureSpace limit ifTrue: - [^self]. - - previousRememberedSetSize := rememberedSetSize. - self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorSpaceLimit. - previousFutureSurvivorSpaceLimit = rememberedSetSize ifTrue: - [^self]. - - previousFutureSurvivorSpaceLimit := futureSpace size] repeat! Item was removed: - ----- Method: CogGenerationScavenger>>scavengeReferentsOf: (in category 'api') ----- - scavengeReferentsOf: referrer - "scavengeReferentsOf: referrer inspects all the pointers in referrer. - If any are new objects, it has them moved to FutureSurvivorSpace, - and returns truth. If there are no new referents, it returns falsity." - <var: #referrer type: #'object *'> - | foundNewReferent referent | - referrer isPointers ifFalse: - [^self]. - foundNewReferent := false. - 0 to: (manager lengthOf: referrer) do: - [:i| - referent := manager fetchPointer: i ofObject: referrer. - (manager isYoung: referent) ifTrue: - [foundNewReferent := true. - referent isForwarded ifFalse: - [self copyAndForward: referent]. - manager - storePointerUnchecked: i - ofObject: referrer - withValue: (manager forwardingPointerOf: referent)]]. - ^foundNewReferent! Item was removed: - ----- Method: CogGenerationScavenger>>scavengeRememberedSetStartingAt: (in category 'api') ----- - scavengeRememberedSetStartingAt: n - "scavengeRememberedSetStartingAt: n traverses objects in the remembered - set starting at the nth one. If the object does not refer to any new objects, it - is removed from the set. Otherwise, its new referents are scavenged." - | destIndex sourceIndex | - sourceIndex := destIndex := n. - [sourceIndex < rememberedSetSize] whileTrue: - [| referree | - referree := rememberedSet at: sourceIndex. - (self scavengeReferentsOf: referree) - ifTrue: - [rememberedSet at: destIndex put: referree. - destIndex := destIndex + 1] - ifFalse: - [referree isRemembered: false]. - sourceIndex := sourceIndex + 1]. - rememberedSetSize := destIndex! Item was removed: - CogClass subclass: #CogMemoryManager (excessive size, no diff calculated) Item was removed: - ----- Method: CogMemoryManager class>>initialize (in category 'class initialization') ----- - initialize - "CogObjectMemory initialize" - NumFreeLists := 65 "One for each size up to and including 64 slots. One for sizes > 64 slots."! Item was removed: - ----- Method: CogMemoryManager>>addToFreeList: (in category 'garbage collection') ----- - addToFreeList: freeChunk - | chunkBytes childBytes parent child index | - chunkBytes := self bytesInObject: freeChunk. - index := chunkBytes / self wordSize. - index < NumFreeLists ifTrue: - [self storePointerUnchecked: 0 ofObject: freeChunk withValue: (freeLists at: index). - freeLists at: index put: freeChunk. - ^self]. - self - storePointerUnchecked: self freeChunkNextIndex ofObject: freeChunk withValue: 0; - storePointerUnchecked: self freeChunkParentIndex ofObject: freeChunk withValue: 0; - storePointerUnchecked: self freeChunkSmallerIndex ofObject: freeChunk withValue: 0; - storePointerUnchecked: self freeChunkLargerIndex ofObject: freeChunk withValue: 0. - "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. - Beneath the node are smaller and larger blocks." - parent := 0. - child := freeLists at: 0. - [child ~= 0] whileTrue: - [childBytes := self bytesInObject: child. - childBytes = chunkBytes ifTrue: "size match; add to list at node." - [self storePointerUnchecked: self freeChunkNextIndex - ofObject: freeChunk - withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); - storePointerUnchecked: self freeChunkNextIndex - ofObject: child - withValue: freeChunk. - ^self]. - "walk down the tree" - parent := child. - child := self fetchPointer: (childBytes > chunkBytes - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofObject: child]. - parent = 0 ifTrue: - [self assert: (freeLists at: 0) = 0. - freeLists at: 0 put: freeChunk. - ^self]. - "insert in tree" - self storePointerUnchecked: self freeChunkParentIndex - ofObject: freeChunk - withValue: parent. - self storePointerUnchecked: (childBytes > chunkBytes - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofObject: parent - withValue: freeChunk! Item was removed: - ----- Method: CogMemoryManager>>addressAfter: (in category 'object enumeration') ----- - addressAfter: objOop - "Answer the address immediately following an object." - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>adjustAllOopsBy: (in category 'initialization') ----- - adjustAllOopsBy: bytesToShift - "Adjust all oop references by the given number of bytes. This - is done just after reading in an image when the new base - address of the object heap is different from the base address - in the image." - "di 11/18/2000 - return number of objects found" - - | obj | - <inline: false> - bytesToShift ~= 0 ifTrue: - [obj := self firstObject. - [self oop: obj isLessThan: freeStart] whileTrue: - [(self isFreeObject: obj) ifFalse: - [self adjustFieldsAndClassOf: obj by: bytesToShift]. - obj := self objectAfter: obj]]! Item was removed: - ----- Method: CogMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- - adjustFieldsAndClassOf: oop by: offsetBytes - "Adjust all pointers in this object by the given offset." - self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>allObjectsDo: (in category 'debug support') ----- - allObjectsDo: aBlock - <doNotGenerate> - | prevObj prevPrevObj objOop | - prevPrevObj := prevObj := nil. - objOop := self firstObject. - [self assert: objOop \\ self allocationUnit = 0. - objOop < freeStart] whileTrue: - [(self isFreeObject: objOop) ifFalse: - [aBlock value: objOop]. - prevPrevObj := prevObj. - prevObj := objOop. - objOop := self objectAfter: objOop]. - prevPrevObj class. - prevObj class! Item was removed: - ----- Method: CogMemoryManager>>allocateMemoryOfSize: (in category 'simulation') ----- - allocateMemoryOfSize: limit - <doNotGenerate> - memory := (self endianness == #little - ifTrue: [LittleEndianBitmap] - ifFalse: [Bitmap]) new: (limit roundUpTo: 8). - freeStart := startOfMemory := 0. - scavengeThreshold := newSpaceLimit := memory size * 4 "Bitmap is a 4-byte per word array"! Item was removed: - ----- Method: CogMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') ----- - allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes - <doNotGenerate> - self assert: (memoryBytes \\ self allocationUnit = 0 - and: [newSpaceBytes \\ self allocationUnit = 0 - and: [codeBytes \\ self allocationUnit = 0]]). - memory := (self endianness == #little - ifTrue: [LittleEndianBitmap] - ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4. - startOfMemory := codeBytes. - endOfMemory := memoryBytes + newSpaceBytes + codeBytes. - "leave newSpace empty for the bootstrap" - freeStart := newSpaceBytes + startOfMemory. - newSpaceStart := startOfMemory. - newSpaceLimit := newSpaceBytes + startOfMemory. - scavengeThreshold := memory size * 4 "Bitmap is a 4-byte per word array"! Item was removed: - ----- Method: CogMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- - allocateSlots: numSlots format: formatField classIndex: classIndex - self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>allocationUnit (in category 'allocation') ----- - allocationUnit - "All objects are a multiple of 8 bytes in length" - ^8! Item was removed: - ----- Method: CogMemoryManager>>arrayClassIndexPun (in category 'class table') ----- - arrayClassIndexPun - "Class puns are class indices not used by any class. There is an entry - for the pun that refers to the notional class of objects with this class - index. But because the index doesn't match the class it won't show up - in allInstances, hence hiding the object with a pun as its class index. - The puns occupy indices 16 through 31." - ^16! Item was removed: - ----- Method: CogMemoryManager>>arrayFormat (in category 'header format') ----- - arrayFormat - ^2! Item was removed: - ----- Method: CogMemoryManager>>baseHeader: (in category 'header access') ----- - baseHeader: obj - ^self longLongAt: obj! Item was removed: - ----- Method: CogMemoryManager>>baseHeaderSize (in category 'header format') ----- - baseHeaderSize - "Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow), - 16 bytes otherwise (slot size in preceeding word)." - ^8! Item was removed: - ----- Method: CogMemoryManager>>bytesPerSlot (in category 'header format') ----- - bytesPerSlot - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>characterObjectOf: (in category 'object access') ----- - characterObjectOf: characterCode - ^characterCode << self numTagBits + self characterTag! Item was removed: - ----- Method: CogMemoryManager>>characterTag (in category 'object access') ----- - characterTag - ^2! Item was removed: - ----- Method: CogMemoryManager>>classIndexMask (in category 'header format') ----- - classIndexMask - "22-bit class mask => ~ 4M classes" - ^16r3fffff! Item was removed: - ----- Method: CogMemoryManager>>classIndexOf: (in category 'header access') ----- - classIndexOf: objOop - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>classTableMajorIndexShift (in category 'class table') ----- - classTableMajorIndexShift - "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages" - ^10! Item was removed: - ----- Method: CogMemoryManager>>classTableMinorIndexMask (in category 'class table') ----- - classTableMinorIndexMask - "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages" - "self basicNew classTableMinorIndexMask" - ^1 << self classTableMajorIndexShift - 1! Item was removed: - ----- Method: CogMemoryManager>>classTablePageSize (in category 'class table') ----- - classTablePageSize - "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages" - "self basicNew classTablePageSize" - ^1 << self classTableMajorIndexShift! Item was removed: - ----- Method: CogMemoryManager>>classTableRootObj (in category 'accessing') ----- - classTableRootObj - "For mapInterpreterOops & bootstrap" - ^classTableRootObj! Item was removed: - ----- Method: CogMemoryManager>>classTableRootObj: (in category 'accessing') ----- - classTableRootObj: anOop - "For mapInterpreterOops" - classTableRootObj := anOop! Item was removed: - ----- Method: CogMemoryManager>>coInterpreter: (in category 'simulation') ----- - coInterpreter: aCoInterpreter - <doNotGenerate> - coInterpreter := aCoInterpreter! Item was removed: - ----- Method: CogMemoryManager>>ensureBehaviorHash: (in category 'class table') ----- - ensureBehaviorHash: aBehavior - | newHash err | - self assert: (self isIntegerObject: aBehavior) not. - (newHash := self hashBitsOf: aBehavior) = 0 ifTrue: - [(err := self enterIntoClassTable: aBehavior) ~= 0 ifTrue: - [^err negated]. - newHash := self hashBitsOf: aBehavior]. - ^newHash! Item was removed: - ----- Method: CogMemoryManager>>enterIntoClassTable: (in category 'class table') ----- - enterIntoClassTable: aBehavior - "Enter aBehavior into the class table and answer 0. Otherwise answer a primitive failure code." - self shouldBeImplemented! Item was removed: - ----- Method: CogMemoryManager>>falseObject (in category 'accessing') ----- - falseObject - ^falseObj! Item was removed: - ----- Method: CogMemoryManager>>falseObject: (in category 'accessing') ----- - falseObject: anOop - "For mapInterpreterOops" - falseObj := anOop! Item was removed: - ----- Method: CogMemoryManager>>fetchLong32:ofObject: (in category 'object access') ----- - fetchLong32: fieldIndex ofObject: oop - "index by 32-bit units, and return a 32-bit value. Intended to replace fetchWord:ofObject:" - - ^self long32At: oop + self baseHeaderSize + (fieldIndex << 2)! Item was removed: - ----- Method: CogMemoryManager>>firstCompiledMethodFormat (in category 'header format') ----- - firstCompiledMethodFormat - ^24! Item was removed: - ----- Method: CogMemoryManager>>firstObject (in category 'object enumeration') ----- - firstObject - "Return the first object or free chunk in the heap." - - ^nilObj! Item was removed: - ----- Method: CogMemoryManager>>formatMask (in category 'header format') ----- - formatMask - ^16r1f! Item was removed: - ----- Method: CogMemoryManager>>formatOf: (in category 'object access') ----- - formatOf: objOop - "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,7,8 unused - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>formatOfHeader: (in category 'object access') ----- - formatOfHeader: header - <var: 'header' type: #usqLong> - "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,7,8 unused - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" - ^header >> self formatShift bitAnd: self formatMask! Item was removed: - ----- Method: CogMemoryManager>>formatShift (in category 'header format') ----- - formatShift - ^24! Item was removed: - ----- Method: CogMemoryManager>>freeChunkLargerIndex (in category 'garbage collection') ----- - freeChunkLargerIndex - ^3! Item was removed: - ----- Method: CogMemoryManager>>freeChunkNextIndex (in category 'garbage collection') ----- - freeChunkNextIndex - ^0! Item was removed: - ----- Method: CogMemoryManager>>freeChunkParentIndex (in category 'garbage collection') ----- - freeChunkParentIndex - ^1! Item was removed: - ----- Method: CogMemoryManager>>freeChunkSmallerIndex (in category 'garbage collection') ----- - freeChunkSmallerIndex - ^2! Item was removed: - ----- Method: CogMemoryManager>>freeStart (in category 'accessing') ----- - freeStart - ^freeStart! Item was removed: - ----- Method: CogMemoryManager>>headerForSlots:format:classIndex: (in category 'header format') ----- - headerForSlots: numSlots format: formatField classIndex: classIndex - "The header format in LSB is - MSB: | 8: slotSize | (on a byte boundary) - | 2 bits | - | 22: identityHash | (on a word boundary) - | 3 bits | - | 5: format | (on a byte boundary) - | 2 bits | - | 22: classIndex | (on a word boundary) : LSB - The remaining bits (7) need to be used for - isGrey - isMarked - isRemembered - isPinned - isImmutable - leaving 2 unused bits." - ^ (numSlots << self numSlotsFullShift) - + (formatField << self formatShift) - + classIndex! Item was removed: - ----- Method: CogMemoryManager>>identityHashHalfWordMask (in category 'header format') ----- - identityHashHalfWordMask - ^16r3fffff! Item was removed: - ----- Method: CogMemoryManager>>indexablePointersFormat (in category 'header format') ----- - indexablePointersFormat - ^3! Item was removed: - ----- Method: CogMemoryManager>>initFreeChunkWithBytes:at: (in category 'garbage collection') ----- - initFreeChunkWithBytes: numBytes at: address - | numSlots | - self assert: numBytes \\ self allocationUnit = 0. - numSlots := numBytes >> self shiftForWord - - (numBytes >= (self numSlotsMask << self shiftForWord) - ifTrue: [self baseHeaderSize + self baseHeaderSize / self wordSize] - ifFalse: [self baseHeaderSize / self wordSize]). - ^self initFreeChunkWithSlots: numSlots at: address! Item was removed: - ----- Method: CogMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- - initFreeChunkWithSlots: numSlots at: address - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>initialize (in category 'initialization') ----- - initialize - freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0)! Item was removed: - ----- Method: CogMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- - initializeObjectMemory: bytesToShift - "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." - "Assume: image reader initializes the following variables: - memory - memoryLimit - specialObjectsOop - lastHash - " - <inline: false> - "image may be at a different address; adjust oops for new location" - self adjustAllOopsBy: bytesToShift. - - self initializeOldSpaceFirstFree: endOfOldSpace. "initializes endOfMemory, freeStart" - - specialObjectsOop := specialObjectsOop + bytesToShift. - - "heavily used special objects" - nilObj := self splObj: NilObject. - falseObj := self splObj: FalseObject. - trueObj := self splObj: TrueObject. - - "rootTableCount := 0. - rootTableOverflowed := false. - lowSpaceThreshold := 0. - signalLowSpace := false. - compStart := 0. - compEnd := 0. - fwdTableNext := 0. - fwdTableLast := 0. - remapBufferCount := 0. - tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold"" - growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing"" - shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking"" - - ""garbage collection statistics"" - statFullGCs := 0. - statFullGCUsecs := 0. - statIncrGCs := 0. - statIncrGCUsecs := 0. - statTenures := 0. - statRootTableOverflows := 0. - statGrowMemory := 0. - statShrinkMemory := 0. - forceTenureFlag := 0. - gcBiasToGrow := 0. - gcBiasToGrowGCLimit := 0. - extraRootCount := 0."! Item was removed: - ----- Method: CogMemoryManager>>initializeOldSpaceFirstFree: (in category 'garbage collection') ----- - initializeOldSpaceFirstFree: startOfFreeOldSpace - <var: 'startOfFreeOldSpace' type: #usqLong> - | freeOldStart freeChunk | - <var: 'freeOldStart' type: #usqLong> - 0 to: NumFreeLists - 1 do: - [:i| freeLists at: i put: 0]. - freeOldStart := startOfFreeOldSpace. - [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: - [freeChunk := self initFreeChunkWithSlots: (2 raisedTo: 32) / self wordSize at: freeOldStart. - self addToFreeList: freeChunk. - freeOldStart := self addressAfter: freeChunk]. - freeChunk := self initFreeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. - self addToFreeList: freeChunk. - self assert: (self addressAfter: freeChunk) = endOfMemory! Item was removed: - ----- Method: CogMemoryManager>>initializePostBootstrap (in category 'simulation') ----- - initializePostBootstrap - "The heap has just been bootstrapped into a modified newSpace occupying all of memory above newSPace (and the codeZone). - Put things back to some kind of normalicy." - endOfOldSpace := freeStart. - freeStart := newSpaceStart! Item was removed: - ----- Method: CogMemoryManager>>isCompiledMethod: (in category 'object testing') ----- - isCompiledMethod: objOop - "Answer whether the argument object is of compiled method format" - <api> - ^(self formatOf: objOop) >= 24! Item was removed: - ----- Method: CogMemoryManager>>isFreeObject: (in category 'header access') ----- - isFreeObject: objOop - ^(self classIndexOf: objOop) = 0! Item was removed: - ----- Method: CogMemoryManager>>isImmediate: (in category 'object testing') ----- - isImmediate: oop - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>isPointersNonImm: (in category 'object testing') ----- - isPointersNonImm: objOop - ^(self formatOf: objOop) <= 5! Item was removed: - ----- Method: CogMemoryManager>>lastPointerFormat (in category 'header format') ----- - lastPointerFormat - ^5! Item was removed: - ----- Method: CogMemoryManager>>lastPointerOf: (in category 'object enumeration') ----- - lastPointerOf: obj - "Answer the byte offset of the last pointer field of the given object. - Works with CompiledMethods, as well as ordinary objects." - <api> - <inline: true> - <asmLabel: false> - | fmt header contextSize numLiterals | - <var: 'header' type: #usqLong> - header := self baseHeader: obj. - fmt := self formatOfHeader: header. - fmt <= self lastPointerFormat ifTrue: - [(fmt = self indexablePointersFormat - and: [self isContextHeader: header]) ifTrue: - ["contexts end at the stack pointer" - contextSize := coInterpreter fetchStackPointerOf: obj. - ^CtxtTempFrameStart + contextSize * BytesPerOop]. - ^(self numSlotsOf: obj) * BytesPerOop "all pointers"]. - fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" - - "CompiledMethod: contains both pointers and bytes" - numLiterals := coInterpreter literalCountOf: obj. - ^numLiterals + LiteralStart * BytesPerOop! Item was removed: - ----- Method: CogMemoryManager>>nilFieldsOf: (in category 'primitive support') ----- - nilFieldsOf: obj - 0 to: (self numSlotsOf: obj) - 1 do: - [:i| - self storePointerUnchecked: i ofObject: obj withValue: nilObj]! Item was removed: - ----- Method: CogMemoryManager>>nilObject (in category 'accessing') ----- - nilObject - ^nilObj! Item was removed: - ----- Method: CogMemoryManager>>nilObject: (in category 'accessing') ----- - nilObject: anOop - "For mapInterpreterOops" - nilObj := anOop! Item was removed: - ----- Method: CogMemoryManager>>numSlotsFullShift (in category 'header format') ----- - numSlotsFullShift - ^56! Item was removed: - ----- Method: CogMemoryManager>>numSlotsHalfShift (in category 'header format') ----- - numSlotsHalfShift - ^24! Item was removed: - ----- Method: CogMemoryManager>>numSlotsMask (in category 'header format') ----- - numSlotsMask - "8-bit slot count - max 64-bit small obj size 254 * 8 = 2032 bytes - max 32-bit small obj size 254 * 4 = 1016 bytes" - ^255! Item was removed: - ----- Method: CogMemoryManager>>numSlotsOf: (in category 'object access') ----- - numSlotsOf: objOop - <returnTypeC: #usqInt> - | halfHeader numSlots | - self flag: #endianness. - halfHeader := self longAt: objOop + 4. - numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. - ^numSlots = self numSlotsMask - ifTrue: [self longAt: objOop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty" - ifFalse: [numSlots]! Item was removed: - ----- Method: CogMemoryManager>>numTagBits (in category 'object access') ----- - numTagBits - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>objectAfter: (in category 'object enumeration') ----- - objectAfter: objOop - "Object parsing. - 1. all objects have at least a word following the header, for a forwarding pointer. - 2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following - an object doesn't have a saturated size field it must be a single-header object. If the word following - does have a saturated slotSize it must be the overflow size word." - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>overflowSlotsMask (in category 'header format') ----- - overflowSlotsMask - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>setHashBitsOf:to: (in category 'header access') ----- - setHashBitsOf: objOop to: hash - self assert: (hash between: 0 and: self identityHashHalfWordMask). - self longAt: objOop - put: ((self longAt: objOop) bitClear: self identityHashHalfWordMask) + hash! Item was removed: - ----- Method: CogMemoryManager>>specialObjectsOop (in category 'accessing') ----- - specialObjectsOop - ^specialObjectsOop! Item was removed: - ----- Method: CogMemoryManager>>specialObjectsOop: (in category 'accessing') ----- - specialObjectsOop: anObject - "For mapInterpreterOops" - specialObjectsOop := anObject! Item was removed: - ----- Method: CogMemoryManager>>splObj: (in category 'interpreter access') ----- - splObj: index - <api> - <inline: true> - "Return one of the objects in the specialObjectsArray" - ^self fetchPointer: index ofObject: specialObjectsOop! Item was removed: - ----- Method: CogMemoryManager>>startOfMemory (in category 'accessing') ----- - startOfMemory - "Return the start of object memory. This is immediately after the native code zone. - N.B. the stack zone is alloca'ed. Use a macro so as not to punish the debug VM." - <cmacro: '() heapBase'> - <returnTypeC: #usqInt> - ^coInterpreter ifNil: [startOfMemory] ifNotNil: [coInterpreter heapBase]! Item was removed: - ----- Method: CogMemoryManager>>startOfMemory: (in category 'simulation') ----- - startOfMemory: value - startOfMemory := value. - (freeStart isNil or: [freeStart < value]) ifTrue: - [freeStart := value]! Item was removed: - ----- Method: CogMemoryManager>>storeLong32:ofObject:withValue: (in category 'object access') ----- - storeLong32: fieldIndex ofObject: obj withValue: valueWord - ^self long32At: obj + self baseHeaderSize + (fieldIndex << 2) put: valueWord! Item was removed: - ----- Method: CogMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- - storePointer: fieldIndex ofObject: oop withValue: valuePointer - "Note must check here for stores of young objects into old ones." - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- - storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer - ^self subclassResponsibility! Item was removed: - ----- Method: CogMemoryManager>>trueObject (in category 'accessing') ----- - trueObject - ^trueObj! Item was removed: - ----- Method: CogMemoryManager>>trueObject: (in category 'accessing') ----- - trueObject: anOop - "For mapInterpreterOops" - trueObj := anOop! Item was removed: - ----- Method: CogMemoryManager>>weakArrayClassIndexPun (in category 'class table') ----- - weakArrayClassIndexPun - "Class puns are class indices not used by any class. There is an entry - for the pun that refers to the notional class of objects with this class - index. But because the index doesn't match the class it won't show up - in allInstances, hence hiding the object with a pun as its class index. - The puns occupy indices 16 through 31." - ^17! Item was removed: - ----- Method: CogMemoryManager>>weakArrayFormat (in category 'header format') ----- - weakArrayFormat - ^4! Item was removed: - CogMemoryManager subclass: #CogMemoryManager32Bits - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-MemoryManager'! Item was removed: - ----- Method: CogMemoryManager32Bits>>addressAfter: (in category 'object enumeration') ----- - addressAfter: objOop - "Answer the address immediately following an object." - | numSlots slotBytes | - numSlots := self numSlotsOf: objOop. - slotBytes := numSlots = 0 - ifTrue: [self allocationUnit] - ifFalse: [numSlots + (numSlots bitAnd: 1) << self shiftForWord]. - ^objOop + self baseHeaderSize + slotBytes! Item was removed: - ----- Method: CogMemoryManager32Bits>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- - adjustFieldsAndClassOf: oop by: offsetBytes - "Adjust all pointers in this object by the given offset." - | fieldAddr fieldOop | - <inline: true> - <asmLabel: false> - fieldAddr := oop + (self lastPointerOf: oop). - [self oop: fieldAddr isGreaterThanOrEqualTo: oop + self baseHeaderSize] whileTrue: - [fieldOop := self longAt: fieldAddr. - (self isImmediate: fieldOop) ifFalse: - [self longAt: fieldAddr put: fieldOop + offsetBytes]. - fieldAddr := fieldAddr - BytesPerOop]! Item was removed: - ----- Method: CogMemoryManager32Bits>>allocateSlots:format:classIndex: (in category 'allocation') ----- - allocateSlots: numSlots format: formatField classIndex: classIndex - | numBytes newObj | - "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), - 16 bytes otherwise (slot size in preceeding word). - Objects always have at least one slot, for the forwarding pointer, - and are multiples of 8 bytes in length." - numSlots >= self numSlotsMask - ifTrue: - [newObj := freeStart + self baseHeaderSize. - numBytes := self baseHeaderSize + self baseHeaderSize "double header" - + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" - ifFalse: - [newObj := freeStart. - numBytes := self baseHeaderSize "single header" - + (numSlots <= 1 - ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" - ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" - self assert: numBytes \\ self allocationUnit = 0. - freeStart + numBytes > scavengeThreshold ifTrue: - [freeStart + numBytes > newSpaceLimit ifTrue: - [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. - self scheduleScavenge]. - numSlots >= self numSlotsMask - ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" - [self flag: #endianness. - self longAt: freeStart put: numSlots. - self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. - self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] - ifFalse: - [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. - self assert: numBytes \\ self allocationUnit = 0. - self assert: newObj \\ self allocationUnit = 0. - freeStart := freeStart + numBytes. - ^newObj! Item was removed: - ----- Method: CogMemoryManager32Bits>>bytesInObject: (in category 'object enumeration') ----- - bytesInObject: objOop - "Answer the total number of bytes in an object including header and possible overflow size header." - | halfHeader headerNumSlots numSlots | - self flag: #endianness. - halfHeader := self longAt: objOop + 4. - headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. - numSlots := headerNumSlots = self numSlotsMask - ifTrue: [self longAt: objOop - self baseHeaderSize] - ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]]. - ^numSlots + (numSlots bitAnd: 1) << self shiftForWord - + (headerNumSlots = self numSlotsMask - ifTrue: [self baseHeaderSize + self baseHeaderSize] - ifFalse: [self baseHeaderSize])! Item was removed: - ----- Method: CogMemoryManager32Bits>>bytesPerSlot (in category 'header format') ----- - bytesPerSlot - ^4! Item was removed: - ----- Method: CogMemoryManager32Bits>>classIndexOf: (in category 'header access') ----- - classIndexOf: objOop - self flag: #endianness. - ^(self longAt: objOop) bitAnd: self classIndexMask! Item was removed: - ----- Method: CogMemoryManager32Bits>>fetchPointer:ofObject: (in category 'object access') ----- - fetchPointer: fieldIndex ofObject: objOop - ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was removed: - ----- Method: CogMemoryManager32Bits>>formatOf: (in category 'object access') ----- - formatOf: objOop - "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,7,8 unused - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" - self flag: #endianness. - ^(self longAt: objOop) >> self formatShift bitAnd: self formatMask! Item was removed: - ----- Method: CogMemoryManager32Bits>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- - initFreeChunkWithSlots: numSlots at: address - self flag: #endianness. - self longAt: address put: numSlots; - longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift; - longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks" - longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift. - ^address + 8! Item was removed: - ----- Method: CogMemoryManager32Bits>>isImmediate: (in category 'object testing') ----- - isImmediate: oop - ^(oop bitAnd: 3) ~= 0! Item was removed: - ----- Method: CogMemoryManager32Bits>>numTagBits (in category 'object access') ----- - numTagBits - ^2! Item was removed: - ----- Method: CogMemoryManager32Bits>>objectAfter: (in category 'object enumeration') ----- - objectAfter: objOop - "Object parsing. - 1. all objects have at least a word following the header, for a forwarding pointer. - 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word - following an object doesn't have a saturated numSlots field it must be a single-header object. - If the word following does have a saturated numSlots it must be the overflow size word." - | followingWordAddress followingWord | - followingWordAddress := self addressAfter: objOop. - followingWordAddress >= freeStart ifTrue: - [^freeStart]. - self flag: #endianness. - followingWord := self longAt: followingWordAddress + 4. - ^followingWord >> self numSlotsHalfShift = self numSlotsMask - ifTrue: [followingWordAddress + self baseHeaderSize] - ifFalse: [followingWordAddress]! Item was removed: - ----- Method: CogMemoryManager32Bits>>shiftForWord (in category 'word size') ----- - shiftForWord - ^2! Item was removed: - ----- Method: CogMemoryManager32Bits>>storePointer:ofObject:withValue: (in category 'object access') ----- - storePointer: fieldIndex ofObject: oop withValue: valuePointer - "Note must check here for stores of young objects into old ones." - - (self oop: oop isLessThan: newSpaceLimit) ifFalse: "most stores into young objects" - [(self isImmediate: valuePointer) ifFalse: - [(self oop: valuePointer isLessThan: newSpaceLimit) ifTrue: - [self possibleRootStoreInto: oop value: valuePointer]]]. - - ^self - longAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: CogMemoryManager32Bits>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- - storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer - ^self - longAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: CogMemoryManager32Bits>>wordSize (in category 'word size') ----- - wordSize - ^4! Item was removed: - CogMemoryManager subclass: #CogMemoryManager64Bits - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-MemoryManager'! Item was removed: - ----- Method: CogMemoryManager64Bits>>addressAfter: (in category 'object enumeration') ----- - addressAfter: objOop - "Answer the address immediately following an object." - | numSlots slotBytes | - numSlots := self numSlotsOf: objOop. - slotBytes := numSlots = 0 - ifTrue: [self allocationUnit] - ifFalse: [numSlots << self shiftForWord]. - ^objOop + self baseHeaderSize + slotBytes! Item was removed: - ----- Method: CogMemoryManager64Bits>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- - adjustFieldsAndClassOf: oop by: offsetBytes - "Adjust all pointers in this object by the given offset." - | fieldAddr fieldOop | - <inline: true> - <asmLabel: false> - fieldAddr := oop + (self lastPointerOf: oop). - [self oop: fieldAddr isGreaterThan: oop] whileTrue: - [fieldOop := self longAt: fieldAddr. - (self isIntegerObject: fieldOop) ifFalse: - [self longLongAt: fieldAddr put: fieldOop + offsetBytes]. - fieldAddr := fieldAddr - BytesPerWord]! Item was removed: - ----- Method: CogMemoryManager64Bits>>allocateSlots:format:classIndex: (in category 'allocation') ----- - allocateSlots: numSlots format: formatField classIndex: classIndex - | numBytes newObj | - "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), - 16 bytes otherwise (num slots in preceeding word). - Objects always have at least one slot, for the forwarding pointer, - and are multiples of 8 bytes in length." - numSlots >= self numSlotsMask - ifTrue: - [numSlots > 16rffffffff ifTrue: - [^nil]. - newObj := freeStart + self baseHeaderSize. - numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" - + (numSlots * self bytesPerSlot)] - ifFalse: - [newObj := freeStart. - numBytes := self baseHeaderSize "single header" - + (numSlots < 1 - ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" - ifFalse: [numSlots * self bytesPerSlot])]. - - freeStart + numBytes > scavengeThreshold ifTrue: - [freeStart + numBytes > newSpaceLimit ifTrue: - [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. - self scheduleScavenge]. - numSlots >= self numSlotsMask - ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" - [self flag: #endianness. - self longAt: freeStart put: numSlots. - self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. - self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] - ifFalse: - [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. - freeStart := freeStart + numBytes. - ^newObj! Item was removed: - ----- Method: CogMemoryManager64Bits>>bytesInObject: (in category 'object enumeration') ----- - bytesInObject: objOop - "Answer the total number of bytes in an object including header and possible overflow size header." - | halfHeader headerNumSlots numSlots | - self flag: #endianness. - halfHeader := self longAt: objOop + 4. - headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. - numSlots := headerNumSlots = self numSlotsMask - ifTrue: [self longAt: objOop - self baseHeaderSize] - ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]]. - ^numSlots << self shiftForWord - + (headerNumSlots = self numSlotsMask - ifTrue: [self baseHeaderSize + self baseHeaderSize] - ifFalse: [self baseHeaderSize])! Item was removed: - ----- Method: CogMemoryManager64Bits>>bytesPerSlot (in category 'header format') ----- - bytesPerSlot - ^8! Item was removed: - ----- Method: CogMemoryManager64Bits>>classIndexOf: (in category 'header access') ----- - classIndexOf: objOop - ^(self longLongAt: objOop) bitAnd: self classIndexMask! Item was removed: - ----- Method: CogMemoryManager64Bits>>fetchPointer:ofObject: (in category 'object access') ----- - fetchPointer: fieldIndex ofObject: objOop - ^self longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was removed: - ----- Method: CogMemoryManager64Bits>>formatOf: (in category 'object access') ----- - formatOf: objOop - "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,7,8 unused - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" - ^(self longLongAt: objOop) >> self formatShift bitAnd: self formatMask! Item was removed: - ----- Method: CogMemoryManager64Bits>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- - initFreeChunkWithSlots: numSlots at: address - self flag: #endianness. - self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots; - longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" - ^address + 8! Item was removed: - ----- Method: CogMemoryManager64Bits>>isImmediate: (in category 'object testing') ----- - isImmediate: oop - ^(oop bitAnd: 7) ~= 0! Item was removed: - ----- Method: CogMemoryManager64Bits>>numTagBits (in category 'object access') ----- - numTagBits - "4th bit reserved for object alignment, which could imply e.g. what space the object is in." - ^3! Item was removed: - ----- Method: CogMemoryManager64Bits>>objectAfter: (in category 'object enumeration') ----- - objectAfter: objOop - "Object parsing. - 1. all objects have at least a word following the header, for a forwarding pointer. - 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word - following an object doesn't have a saturated numSlots field it must be a single-header object. - If the word following does have a saturated numSlots it must be the overflow size word." - | followingWordAddress followingWord | - followingWordAddress := self addressAfter: objOop. - followingWordAddress >= freeStart ifTrue: - [^freeStart]. - self flag: #endianness. - followingWord := self longAt: followingWordAddress + 4. - ^followingWord >> self numSlotsHalfShift = self numSlotsMask - ifTrue: [followingWordAddress + self baseHeaderSize] - ifFalse: [followingWordAddress]! Item was removed: - ----- Method: CogMemoryManager64Bits>>shiftForWord (in category 'word size') ----- - shiftForWord - ^3! Item was removed: - ----- Method: CogMemoryManager64Bits>>storePointer:ofObject:withValue: (in category 'object access') ----- - storePointer: fieldIndex ofObject: oop withValue: valuePointer - "Note must check here for stores of young objects into old ones." - - (self oop: oop isLessThan: newSpaceLimit) ifFalse: "most stores into young objects" - [(self isImmediate: valuePointer) ifFalse: - [(self oop: valuePointer isLessThan: newSpaceLimit) ifTrue: - [self possibleRootStoreInto: oop value: valuePointer]]]. - - ^self - longLongAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: CogMemoryManager64Bits>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- - storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer - ^self - longLongAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) - put: valuePointer! Item was removed: - ----- Method: CogMemoryManager64Bits>>wordSize (in category 'word size') ----- - wordSize - ^8! Item was removed: - Object subclass: #CogObjectHeaderSurrogate - instanceVariableNames: 'address memory' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-MemoryManagerSimulation'! Item was removed: - ----- Method: CogObjectHeaderSurrogate class>>alignedByteSize (in category 'accessing') ----- - alignedByteSize - ^8! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>classIndex (in category 'accessing') ----- - classIndex - ^memory unsignedShortAt: address + 1! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>classIndex: (in category 'accessing') ----- - classIndex: aValue - ^memory - unsignedShortAt: address + 1 - put: aValue! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>format (in category 'accessing') ----- - format - ^(memory unsignedByteAt: address + 4) bitAnd: 16r1F! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>format: (in category 'accessing') ----- - format: aValue - self assert: (aValue between: 0 and: 16r1F). - memory - unsignedByteAt: address + 4 - put: ((memory unsignedByteAt: address + 4) bitAnd: 16rE0) + aValue. - ^aValue! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isGrey (in category 'accessing') ----- - isGrey - ^(((memory unsignedByteAt: address + 4) bitShift: -6) bitAnd: 16r1) ~= 0! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isGrey: (in category 'accessing') ----- - isGrey: aValue - memory - unsignedByteAt: address + 4 - put: (((memory unsignedByteAt: address + 4) bitAnd: 16rBF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 6)). - ^aValue! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isImmutable (in category 'accessing') ----- - isImmutable - ^(((memory unsignedByteAt: address + 3) bitShift: -7) bitAnd: 16r1) ~= 0! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isImmutable: (in category 'accessing') ----- - isImmutable: aValue - memory - unsignedByteAt: address + 3 - put: (((memory unsignedByteAt: address + 3) bitAnd: 16r7F) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 7)). - ^aValue! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isMarked (in category 'accessing') ----- - isMarked - ^(((memory unsignedByteAt: address + 4) bitShift: -5) bitAnd: 16r1) ~= 0! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isMarked: (in category 'accessing') ----- - isMarked: aValue - memory - unsignedByteAt: address + 4 - put: (((memory unsignedByteAt: address + 4) bitAnd: 16rDF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 5)). - ^aValue! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isPinned (in category 'accessing') ----- - isPinned - ^(((memory unsignedByteAt: address + 3) bitShift: -6) bitAnd: 16r1) ~= 0! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isPinned: (in category 'accessing') ----- - isPinned: aValue - memory - unsignedByteAt: address + 3 - put: (((memory unsignedByteAt: address + 3) bitAnd: 16rBF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 6)). - ^aValue! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isRemembered (in category 'accessing') ----- - isRemembered - ^(((memory unsignedByteAt: address + 4) bitShift: -7) bitAnd: 16r1) ~= 0! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>isRemembered: (in category 'accessing') ----- - isRemembered: aValue - memory - unsignedByteAt: address + 4 - put: (((memory unsignedByteAt: address + 4) bitAnd: 16r7F) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 7)). - ^aValue! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>objHash (in category 'accessing') ----- - objHash - ^(memory unsignedLongAt: address + 5) bitAnd: 16rFFFFFF! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>objHash: (in category 'accessing') ----- - objHash: aValue - self assert: (aValue between: 0 and: 16rFFFFFF). - memory - unsignedLongAt: address + 5 - put: ((memory unsignedLongAt: address + 5) bitAnd: 16rFF000000) + aValue. - ^aValue! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>slotSize (in category 'accessing') ----- - slotSize - ^memory unsignedByteAt: address + 8! Item was removed: - ----- Method: CogObjectHeaderSurrogate>>slotSize: (in category 'accessing') ----- - slotSize: aValue - ^memory - unsignedByteAt: address + 8 - put: aValue! Item was changed: CogObjectRepresentation subclass: #CogObjectRepresentationForSqueakV3 instanceVariableNames: '' classVariableNames: 'RootBitDigitLength' + poolDictionaries: 'VMSqueakClassIndices VMSqueakV3ObjectRepresentationConstants' - poolDictionaries: 'VMSqueakV3ObjectRepresentationConstants' category: 'VMMaker-JIT'! !CogObjectRepresentationForSqueakV3 commentStamp: '<historical>' prior: 0! Read my superclass' class comment. I am a CogObjectRepresentation for the Squeak V3 object representation.! Item was changed: VMClass subclass: #InterpreterPrimitives instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields' classVariableNames: 'CrossedX EndOfRun MillisecondClockMask' + poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets' - poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets' category: 'VMMaker-Interpreter'! !InterpreterPrimitives commentStamp: 'eem 12/11/2012 17:11' prior: 0! InterpreterPrimitives implements most of the VM's core primitives. It is the root of the interpreter hierarchy so as to share the core primitives amongst the varioius interpreters. Instance Variables argumentCount: <Integer> messageSelector: <Integer> newMethod: <Integer> nextProfileTick: <Integer> objectMemory: <ObjectMemory> (simulation only) preemptionYields: <Boolean> primFailCode: <Integer> profileMethod: <Integer> profileProcess: <Integer> profileSemaphore: <Integer> argumentCount - the number of arguments of the current message messageSelector - the oop of the selector of the current message newMethod - the oop of the result of looking up the current message nextProfileTick - the millisecond clock value of the next profile tick (if profiling is in effect) objectMemory - the memory manager and garbage collector that manages the heap preemptionYields - a boolean controlling the process primitives. If true (old, incorrect, blue-book semantics) a preempted process is sent to the back of its run-queue. If false, a process preempted by a higher-priority process is put back at the head of its run queue, hence preserving cooperative scheduling within priorities. primFailCode - primtiive success/failure flag, 0 for success, otherwise the reason code for failure profileMethod - the oop of the method at the time nextProfileTick was reached profileProcess - the oop of the activeProcess at the time nextProfileTick was reached profileSemaphore - the oop of the semaphore to signal when nextProfileTick is reached ! Item was removed: - ----- Method: NewspeakInterpreter class>>initializePrimitiveErrorCodes (in category 'initialization') ----- - initializePrimitiveErrorCodes - "NewspeakInterpreter initializePrimitiveErrorCodes" - | pet | - PrimErrTableIndex := 51. "Zero-relative" - pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1. - PrimNoErr := 0. "for helper methods that need to answer success or an error code." - PrimErrGenericFailure := pet indexOf: nil. - PrimErrBadReceiver := pet indexOf: #'bad receiver'. - PrimErrBadArgument := pet indexOf: #'bad argument'. - PrimErrBadIndex := pet indexOf: #'bad index'. - PrimErrBadNumArgs := pet indexOf: #'bad number of arguments'. - PrimErrInappropriate := pet indexOf: #'inappropriate operation'. - PrimErrUnsupported := pet indexOf: #'unsupported operation'. - PrimErrNoModification := pet indexOf: #'no modification'. - PrimErrNoMemory := pet indexOf: #'insufficient object memory'. - PrimErrNoCMemory := pet indexOf: #'insufficient C memory'. - PrimErrNotFound := pet indexOf: #'not found'! Item was changed: VMClass subclass: #ObjectMemory instanceVariableNames: 'memory youngStart endOfMemory memoryLimit nilObj falseObj trueObj specialObjectsOop rootTable rootTableCount rootTableOverflowed extraRoots extraRootCount weakRoots weakRootCount child field parentField freeBlock lastHash allocationCount lowSpaceThreshold signalLowSpace compStart compEnd fwdTableNext fwdTableLast remapBuffer remapBufferCount allocationsBetweenGCs tenuringThreshold gcBiasToGrow gcBiasToGrowGCLimit gcBiasToGrowThreshold statFullGCs statIncrGCs statFullGCUsecs statIncrGCUsecs statGCEndTime statIGCDeltaUsecs statTenures statRootTableOverflows freeContexts freeLargeContexts interruptCheckCounter totalObjectCount shrinkThreshold growHeadroom headerTypeBytes youngStartLocal statMarkCount statMarkCountLocal statSweepCount statMkFwdCount statCompMoveCount statGrowMemory statShrinkMemory statRootTableCount statAllocationCount statSurvivorCount statSpecialMarkCount forceTenureFlag gcStartUsecs' classVariableNames: 'AllButHashBits AllButImmutabilityBit AllButMarkBit AllButMarkBitAndTypeMask AllButRootBit Done ExtraRootSize GCTopMarker HashBits HeaderTypeClass HeaderTypeExtraBytes HeaderTypeFree HeaderTypeGC LongSizeNumBits NilContext RemapBufferSize RootTableRedZone RootTableSize StartField StartObj Upward WeakRootTableSize WordMask' + poolDictionaries: 'VMBasicConstants VMObjectIndices VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants' - poolDictionaries: 'VMBasicConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants' category: 'VMMaker-Interpreter'! !ObjectMemory commentStamp: '<historical>' prior: 0! This class describes a 32-bit direct-pointer object memory for Smalltalk. The model is very simple in principle: a pointer is either a SmallInteger or a 32-bit direct object pointer. SmallIntegers are tagged with a low-order bit equal to 1, and an immediate 31-bit 2s-complement signed value in the rest of the word. All object pointers point to a header, which may be followed by a number of data fields. This object memory achieves considerable compactness by using a variable header size (the one complexity of the design). The format of the 0th header word is as follows: 3 bits reserved for gc (mark, root, unused) 12 bits object hash (for HashSets) 5 bits compact class index 4 bits object format 6 bits object size in 32-bit words 2 bits header type (0: 3-word, 1: 2-word, 2: forbidden, 3: 1-word) If a class is in the compact class table, then this is the only header information needed. If it is not, then it will have another header word at offset -4 bytes with its class in the high 30 bits, and the header type repeated in its low 2 bits. It the objects size is greater than 255 bytes, then it will have yet another header word at offset -8 bytes with its full word size in the high 30 bits and its header type repeated in the low two bits. The object format field provides the remaining information as given in the formatOf: method (including isPointers, isVariable, isBytes, and the low 2 size bits of byte-sized objects). This implementation includes incremental (2-generation) and full garbage collection, each with compaction and rectification of direct pointers. It also supports a bulk-become (exchange object identity) feature that allows many objects to be becomed at once, as when all instances of a class must be grown or shrunk. There is now a simple 64-bit version of the object memory. It is the simplest possible change that could work. It merely sign-extends all integer oops, and extends all object headers and oops by adding 32 zeroes in the high bits. The format of the base header word is changed in one minor, not especially elegant, way. Consider the old 32-bit header: ggghhhhhhhhhhhhcccccffffsssssstt The 64-bit header is almost identical, except that the size field (now being in units of 8 bytes, has a zero in its low-order bit. At the same time, the byte-size residue bits for byte objects, which are in the low order bits of formats 8-11 and 12-15, are now in need of another bit of residue. So, the change is as follows: ggghhhhhhhhhhhhcccccffffsssssrtt where bit r supplies the 4's bit of the byte size residue for byte objects. Oh, yes, this is also needed now for 'variableWord' objects, since their size in 32-bit words requires a low-order bit. See the comment in formatOf: for the change allowing for 64-bit wide bitmaps, now dubbed 'variableLong'.! Item was removed: - ----- Method: ObjectMemory class>>initializePrimitiveErrorCodes (in category 'initialization') ----- - initializePrimitiveErrorCodes - "Define the VM's primitive error codes. N.B. these are - replicated in platforms/Cross/vm/sqVirtualMachine.h." - "ObjectMemory initializePrimitiveErrorCodes" - | pet | - PrimErrTableIndex := 51. "Zero-relative" - "See SmalltalkImage>>recreateSpecialObjectsArray for the table definition. - If the table exists and is large enough the corresponding entry is returned as - the primitive error, otherwise the error is answered numerically." - pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()]. - pet isArray ifFalse: [pet := #()]. - PrimNoErr := 0. "for helper methods that need to answer success or an error code." - PrimErrGenericFailure := pet indexOf: nil ifAbsent: 1. - PrimErrBadReceiver := pet indexOf: #'bad receiver' ifAbsent: 2. - PrimErrBadArgument := pet indexOf: #'bad argument' ifAbsent: 3. - PrimErrBadIndex := pet indexOf: #'bad index' ifAbsent: 4. - PrimErrBadNumArgs := pet indexOf: #'bad number of arguments' ifAbsent: 5. - PrimErrInappropriate := pet indexOf: #'inappropriate operation' ifAbsent: 6. - PrimErrUnsupported := pet indexOf: #'unsupported operation' ifAbsent: 7. - PrimErrNoModification := pet indexOf: #'no modification' ifAbsent: 8. - PrimErrNoMemory := pet indexOf: #'insufficient object memory' ifAbsent: 9. - PrimErrNoCMemory := pet indexOf: #'insufficient C memory' ifAbsent: 10. - PrimErrNotFound := pet indexOf: #'not found' ifAbsent: 11. - PrimErrBadMethod := pet indexOf: #'bad method' ifAbsent: 12. - PrimErrNamedInternal := pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13. - PrimErrObjectMayMove := pet indexOf: #'object may move' ifAbsent: 14. - PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15! Item was added: + Spur32BitMemoryManager subclass: #Spur32BitMMLESimulator + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-MemoryManagerSimulation'! Item was added: + ----- Method: Spur32BitMMLESimulator>>endianness (in category 'memory access') ----- + endianness + ^#little! Item was added: + ----- Method: Spur32BitMMLESimulator>>headerForSlots:format:classIndex: (in category 'header format') ----- + headerForSlots: numSlots format: formatField classIndex: classIndex + "The header format in LSB is + MSB: | 2 bits | + | 22: identityHash | + | 8: slotSize | + | 3 bits | + | 5: format | + | 2 bits | + | 22: classIndex | : LSB" + self assert: (numSlots between: 0 and: self numSlotsMask). + self assert: (formatField between: 0 and: 31). + self assert: (classIndex between: 0 and: 16r3fffff). + ^super headerForSlots: numSlots format: formatField classIndex: classIndex! Item was added: + ----- Method: Spur32BitMMLESimulator>>long32At:put: (in category 'memory access') ----- + long32At: byteAddress put: a32BitValue + "Store the 32-bit value at byteAddress which must be 0 mod 4." + + ^self longAt: byteAddress put: a32BitValue! Item was added: + ----- Method: Spur32BitMMLESimulator>>longAt: (in category 'memory access') ----- + longAt: byteAddress + "Note: Adjusted for Smalltalk's 1-based array indexing." + byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. + ^memory at: byteAddress // 4 + 1! Item was added: + ----- Method: Spur32BitMMLESimulator>>longAt:put: (in category 'memory access') ----- + longAt: byteAddress put: a32BitValue + "Note: Adjusted for Smalltalk's 1-based array indexing." + byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. + ^memory at: byteAddress // 4 + 1 put: a32BitValue! Item was added: + ----- Method: Spur32BitMMLESimulator>>longLongAt: (in category 'memory access') ----- + longLongAt: byteAddress + "memory is a Bitmap, a 32-bit indexable array of bits" + | hiWord loWord | + byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. + loWord := memory at: byteAddress // 4 + 1. + hiWord := memory at: byteAddress // 4 + 2. + ^hiWord = 0 + ifTrue: [loWord] + ifFalse: [(hiWord bitShift: 32) + loWord]! Item was added: + ----- Method: Spur32BitMMLESimulator>>longLongAt:put: (in category 'memory access') ----- + longLongAt: byteAddress put: a64BitValue + "memory is a Bitmap, a 32-bit indexable array of bits" + byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. + memory + at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff); + at: byteAddress // 4 + 2 put: a64BitValue >> 32. + ^a64BitValue! Item was added: + ----- Method: Spur32BitMMLESimulator>>unalignedAccessError (in category 'memory access') ----- + unalignedAccessError + ^self error: 'unaligned access'! Item was added: + SpurMemoryManager subclass: #Spur32BitMemoryManager + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-MemoryManager'! Item was added: + ----- Method: Spur32BitMemoryManager>>addressAfter: (in category 'object enumeration') ----- + addressAfter: objOop + "Answer the address immediately following an object." + | numSlots slotBytes | + numSlots := self numSlotsOf: objOop. + slotBytes := numSlots = 0 + ifTrue: [self allocationUnit] + ifFalse: [numSlots + (numSlots bitAnd: 1) << self shiftForWord]. + ^objOop + self baseHeaderSize + slotBytes! Item was added: + ----- Method: Spur32BitMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- + adjustFieldsAndClassOf: oop by: offsetBytes + "Adjust all pointers in this object by the given offset." + | fieldAddr fieldOop | + <inline: true> + <asmLabel: false> + fieldAddr := oop + (self lastPointerOf: oop). + [self oop: fieldAddr isGreaterThanOrEqualTo: oop + self baseHeaderSize] whileTrue: + [fieldOop := self longAt: fieldAddr. + (self isImmediate: fieldOop) ifFalse: + [self longAt: fieldAddr put: fieldOop + offsetBytes]. + fieldAddr := fieldAddr - BytesPerOop]! Item was added: + ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- + allocateSlots: numSlots format: formatField classIndex: classIndex + | numBytes newObj | + "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), + 16 bytes otherwise (slot size in preceeding word). + Objects always have at least one slot, for the forwarding pointer, + and are multiples of 8 bytes in length." + numSlots >= self numSlotsMask + ifTrue: + [newObj := freeStart + self baseHeaderSize. + numBytes := self baseHeaderSize + self baseHeaderSize "double header" + + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" + ifFalse: + [newObj := freeStart. + numBytes := self baseHeaderSize "single header" + + (numSlots <= 1 + ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" + ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" + self assert: numBytes \\ self allocationUnit = 0. + freeStart + numBytes > scavengeThreshold ifTrue: + [freeStart + numBytes > newSpaceLimit ifTrue: + [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. + self scheduleScavenge]. + numSlots >= self numSlotsMask + ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self flag: #endianness. + self longAt: freeStart put: numSlots. + self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] + ifFalse: + [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. + self assert: numBytes \\ self allocationUnit = 0. + self assert: newObj \\ self allocationUnit = 0. + freeStart := freeStart + numBytes. + ^newObj! Item was added: + ----- Method: Spur32BitMemoryManager>>bytesInObject: (in category 'object enumeration') ----- + bytesInObject: objOop + "Answer the total number of bytes in an object including header and possible overflow size header." + | halfHeader headerNumSlots numSlots | + self flag: #endianness. + halfHeader := self longAt: objOop + 4. + headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. + numSlots := headerNumSlots = self numSlotsMask + ifTrue: [self longAt: objOop - self baseHeaderSize] + ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]]. + ^numSlots + (numSlots bitAnd: 1) << self shiftForWord + + (headerNumSlots = self numSlotsMask + ifTrue: [self baseHeaderSize + self baseHeaderSize] + ifFalse: [self baseHeaderSize])! Item was added: + ----- Method: Spur32BitMemoryManager>>bytesPerSlot (in category 'header format') ----- + bytesPerSlot + ^4! Item was added: + ----- Method: Spur32BitMemoryManager>>classIndexOf: (in category 'header access') ----- + classIndexOf: objOop + self flag: #endianness. + ^(self longAt: objOop) bitAnd: self classIndexMask! Item was added: + ----- Method: Spur32BitMemoryManager>>fetchPointer:ofObject: (in category 'object access') ----- + fetchPointer: fieldIndex ofObject: objOop + ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was added: + ----- Method: Spur32BitMemoryManager>>formatOf: (in category 'object access') ----- + formatOf: objOop + "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,7,8 unused + 9 (?) 64-bit indexable + 10 - 11 32-bit indexable + 12 - 15 16-bit indexable + 16 - 23 byte indexable + 24 - 31 compiled method" + self flag: #endianness. + ^(self longAt: objOop) >> self formatShift bitAnd: self formatMask! Item was added: + ----- Method: Spur32BitMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- + initFreeChunkWithSlots: numSlots at: address + self flag: #endianness. + self longAt: address put: numSlots; + longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift; + longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks" + longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift. + ^address + 8! Item was added: + ----- Method: Spur32BitMemoryManager>>isImmediate: (in category 'object testing') ----- + isImmediate: oop + ^(oop bitAnd: 3) ~= 0! Item was added: + ----- Method: Spur32BitMemoryManager>>numTagBits (in category 'object access') ----- + numTagBits + ^2! Item was added: + ----- Method: Spur32BitMemoryManager>>objectAfter: (in category 'object enumeration') ----- + objectAfter: objOop + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word + following an object doesn't have a saturated numSlots field it must be a single-header object. + If the word following does have a saturated numSlots it must be the overflow size word." + | followingWordAddress followingWord | + followingWordAddress := self addressAfter: objOop. + followingWordAddress >= freeStart ifTrue: + [^freeStart]. + self flag: #endianness. + followingWord := self longAt: followingWordAddress + 4. + ^followingWord >> self numSlotsHalfShift = self numSlotsMask + ifTrue: [followingWordAddress + self baseHeaderSize] + ifFalse: [followingWordAddress]! Item was added: + ----- Method: Spur32BitMemoryManager>>shiftForWord (in category 'word size') ----- + shiftForWord + ^2! Item was added: + ----- Method: Spur32BitMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- + storePointer: fieldIndex ofObject: oop withValue: valuePointer + "Note must check here for stores of young objects into old ones." + + (self oop: oop isLessThan: newSpaceLimit) ifFalse: "most stores into young objects" + [(self isImmediate: valuePointer) ifFalse: + [(self oop: valuePointer isLessThan: newSpaceLimit) ifTrue: + [self possibleRootStoreInto: oop value: valuePointer]]]. + + ^self + longAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! Item was added: + ----- Method: Spur32BitMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- + storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer + ^self + longAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! Item was added: + ----- Method: Spur32BitMemoryManager>>wordSize (in category 'word size') ----- + wordSize + ^4! Item was added: + SpurMemoryManager subclass: #Spur64BitMemoryManager + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-MemoryManager'! Item was added: + ----- Method: Spur64BitMemoryManager>>addressAfter: (in category 'object enumeration') ----- + addressAfter: objOop + "Answer the address immediately following an object." + | numSlots slotBytes | + numSlots := self numSlotsOf: objOop. + slotBytes := numSlots = 0 + ifTrue: [self allocationUnit] + ifFalse: [numSlots << self shiftForWord]. + ^objOop + self baseHeaderSize + slotBytes! Item was added: + ----- Method: Spur64BitMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- + adjustFieldsAndClassOf: oop by: offsetBytes + "Adjust all pointers in this object by the given offset." + | fieldAddr fieldOop | + <inline: true> + <asmLabel: false> + fieldAddr := oop + (self lastPointerOf: oop). + [self oop: fieldAddr isGreaterThan: oop] whileTrue: + [fieldOop := self longAt: fieldAddr. + (self isIntegerObject: fieldOop) ifFalse: + [self longLongAt: fieldAddr put: fieldOop + offsetBytes]. + fieldAddr := fieldAddr - BytesPerWord]! Item was added: + ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- + allocateSlots: numSlots format: formatField classIndex: classIndex + | numBytes newObj | + "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), + 16 bytes otherwise (num slots in preceeding word). + Objects always have at least one slot, for the forwarding pointer, + and are multiples of 8 bytes in length." + numSlots >= self numSlotsMask + ifTrue: + [numSlots > 16rffffffff ifTrue: + [^nil]. + newObj := freeStart + self baseHeaderSize. + numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" + + (numSlots * self bytesPerSlot)] + ifFalse: + [newObj := freeStart. + numBytes := self baseHeaderSize "single header" + + (numSlots < 1 + ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" + ifFalse: [numSlots * self bytesPerSlot])]. + + freeStart + numBytes > scavengeThreshold ifTrue: + [freeStart + numBytes > newSpaceLimit ifTrue: + [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. + self scheduleScavenge]. + numSlots >= self numSlotsMask + ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self flag: #endianness. + self longAt: freeStart put: numSlots. + self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] + ifFalse: + [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. + freeStart := freeStart + numBytes. + ^newObj! Item was added: + ----- Method: Spur64BitMemoryManager>>bytesInObject: (in category 'object enumeration') ----- + bytesInObject: objOop + "Answer the total number of bytes in an object including header and possible overflow size header." + | halfHeader headerNumSlots numSlots | + self flag: #endianness. + halfHeader := self longAt: objOop + 4. + headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. + numSlots := headerNumSlots = self numSlotsMask + ifTrue: [self longAt: objOop - self baseHeaderSize] + ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]]. + ^numSlots << self shiftForWord + + (headerNumSlots = self numSlotsMask + ifTrue: [self baseHeaderSize + self baseHeaderSize] + ifFalse: [self baseHeaderSize])! Item was added: + ----- Method: Spur64BitMemoryManager>>bytesPerSlot (in category 'header format') ----- + bytesPerSlot + ^8! Item was added: + ----- Method: Spur64BitMemoryManager>>classIndexOf: (in category 'header access') ----- + classIndexOf: objOop + ^(self longLongAt: objOop) bitAnd: self classIndexMask! Item was added: + ----- Method: Spur64BitMemoryManager>>fetchPointer:ofObject: (in category 'object access') ----- + fetchPointer: fieldIndex ofObject: objOop + ^self longLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)! Item was added: + ----- Method: Spur64BitMemoryManager>>formatOf: (in category 'object access') ----- + formatOf: objOop + "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,7,8 unused + 9 (?) 64-bit indexable + 10 - 11 32-bit indexable + 12 - 15 16-bit indexable + 16 - 23 byte indexable + 24 - 31 compiled method" + ^(self longLongAt: objOop) >> self formatShift bitAnd: self formatMask! Item was added: + ----- Method: Spur64BitMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- + initFreeChunkWithSlots: numSlots at: address + self flag: #endianness. + self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots; + longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" + ^address + 8! Item was added: + ----- Method: Spur64BitMemoryManager>>isImmediate: (in category 'object testing') ----- + isImmediate: oop + ^(oop bitAnd: 7) ~= 0! Item was added: + ----- Method: Spur64BitMemoryManager>>numTagBits (in category 'object access') ----- + numTagBits + "4th bit reserved for object alignment, which could imply e.g. what space the object is in." + ^3! Item was added: + ----- Method: Spur64BitMemoryManager>>objectAfter: (in category 'object enumeration') ----- + objectAfter: objOop + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word + following an object doesn't have a saturated numSlots field it must be a single-header object. + If the word following does have a saturated numSlots it must be the overflow size word." + | followingWordAddress followingWord | + followingWordAddress := self addressAfter: objOop. + followingWordAddress >= freeStart ifTrue: + [^freeStart]. + self flag: #endianness. + followingWord := self longAt: followingWordAddress + 4. + ^followingWord >> self numSlotsHalfShift = self numSlotsMask + ifTrue: [followingWordAddress + self baseHeaderSize] + ifFalse: [followingWordAddress]! Item was added: + ----- Method: Spur64BitMemoryManager>>shiftForWord (in category 'word size') ----- + shiftForWord + ^3! Item was added: + ----- Method: Spur64BitMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- + storePointer: fieldIndex ofObject: oop withValue: valuePointer + "Note must check here for stores of young objects into old ones." + + (self oop: oop isLessThan: newSpaceLimit) ifFalse: "most stores into young objects" + [(self isImmediate: valuePointer) ifFalse: + [(self oop: valuePointer isLessThan: newSpaceLimit) ifTrue: + [self possibleRootStoreInto: oop value: valuePointer]]]. + + ^self + longLongAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! Item was added: + ----- Method: Spur64BitMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- + storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer + ^self + longLongAt: oop + self baseHeaderSize + (fieldIndex << self shiftForWord) + put: valuePointer! Item was added: + ----- Method: Spur64BitMemoryManager>>wordSize (in category 'word size') ----- + wordSize + ^8! Item was added: + VMClass subclass: #SpurGenerationScavenger + instanceVariableNames: 'coInterpreter manager memory futureSpace pastSpace rememberedSet rememberedSetSize' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-MemoryManager'! Item was added: + ----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'api') ----- + copyAndForward: survivor + "copyAndForward: survivor copies a survivor object either to + futureSurvivorSpace or, if it is to be promoted, to oldSpace. + It leaves a forwarding pointer behind." + <var: #survivor type: #'object *'> + | newLocation | + newLocation := (self shouldBeTenured: survivor) + ifTrue: [self copyToOldSpace: survivor] + ifFalse: [self copyToFutureSpace: survivor]. + manager forward: survivor to: newLocation + ! Item was added: + ----- Method: SpurGenerationScavenger>>scavenge (in category 'api') ----- + scavenge + "The main routine, scavenge, scavenges young objects reachable from the roots (the stack zone + and the rememberedTable). It first scavenges the new objects immediately reachable from the + stack zone, then those directly from old ones (all in the remembered table). Then it scavenges + those that are transitively reachable. If this results in a promotion, the promotee gets remembered, + and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from + the promoted. This loop continues until no more reachable objects are left. At that point, + pastSurvivorSpace is exchanged with futureSurvivorSpace. + + Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize + and previousFutureSurvivorSpaceSize variables ensure that no object is scanned twice, as well as + detecting closure. If this were not true, some pointers might get forwarded twice." + + coInterpreter scavengeStacks. + self scavengeLoop. + self exchange: pastSpace with: futureSpace! Item was added: + ----- Method: SpurGenerationScavenger>>scavengeFutureSurvivorSpaceStartingAt: (in category 'api') ----- + scavengeFutureSurvivorSpaceStartingAt: initialAddress + "scavengeFutureSurvivorSpaceStartingAt: does a depth-first traversal of the + new objects starting at the one at the nth word of futureSurvivorSpace." + | ptr | + <var: #ptr type: #'char *'> + ptr := initialAddress. + [ptr < futureSpace limit] whileTrue: + [| obj | + obj := manager objectAt: ptr. + ptr := ptr + (manager byteLengthOf: obj). + self cCoerceSimple: (self scavengeReferentsOf: obj) + to: #void]! Item was added: + ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'api') ----- + scavengeLoop + "This is the inner loop of the main routine, scavenge. It first scavenges the new objects immediately + reachable from old ones. Then it scavenges those that are transitively reachable. If this results in a + promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee, + then scavenges the ones reachable from the promoted. This loop continues until no more reachable + objects are left. At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace. + + Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize + and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as + detecting closure. If this were not true, some pointers might get forwarded twice." + + | previousRememberedSetSize previousFutureSurvivorSpaceLimit | + previousRememberedSetSize := 0. + previousFutureSurvivorSpaceLimit := futureSpace limit. + self assert: futureSpace limit = futureSpace start. + [self scavengeRememberedSetStartingAt: previousRememberedSetSize. + previousFutureSurvivorSpaceLimit = futureSpace limit ifTrue: + [^self]. + + previousRememberedSetSize := rememberedSetSize. + self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorSpaceLimit. + previousFutureSurvivorSpaceLimit = rememberedSetSize ifTrue: + [^self]. + + previousFutureSurvivorSpaceLimit := futureSpace size] repeat! Item was added: + ----- Method: SpurGenerationScavenger>>scavengeReferentsOf: (in category 'api') ----- + scavengeReferentsOf: referrer + "scavengeReferentsOf: referrer inspects all the pointers in referrer. + If any are new objects, it has them moved to FutureSurvivorSpace, + and returns truth. If there are no new referents, it returns falsity." + <var: #referrer type: #'object *'> + | foundNewReferent referent | + referrer isPointers ifFalse: + [^self]. + foundNewReferent := false. + 0 to: (manager lengthOf: referrer) do: + [:i| + referent := manager fetchPointer: i ofObject: referrer. + (manager isYoung: referent) ifTrue: + [foundNewReferent := true. + referent isForwarded ifFalse: + [self copyAndForward: referent]. + manager + storePointerUnchecked: i + ofObject: referrer + withValue: (manager forwardingPointerOf: referent)]]. + ^foundNewReferent! Item was added: + ----- Method: SpurGenerationScavenger>>scavengeRememberedSetStartingAt: (in category 'api') ----- + scavengeRememberedSetStartingAt: n + "scavengeRememberedSetStartingAt: n traverses objects in the remembered + set starting at the nth one. If the object does not refer to any new objects, it + is removed from the set. Otherwise, its new referents are scavenged." + | destIndex sourceIndex | + sourceIndex := destIndex := n. + [sourceIndex < rememberedSetSize] whileTrue: + [| referree | + referree := rememberedSet at: sourceIndex. + (self scavengeReferentsOf: referree) + ifTrue: + [rememberedSet at: destIndex put: referree. + destIndex := destIndex + 1] + ifFalse: + [referree isRemembered: false]. + sourceIndex := sourceIndex + 1]. + rememberedSetSize := destIndex! Item was added: + CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was added: + ----- Method: SpurMemoryManager class>>initBytesPerWord: (in category 'initialization') ----- + initBytesPerWord: nBytes + + BytesPerWord := nBytes. + ShiftForWord := (BytesPerWord log: 2) rounded. + "The following is necessary to avoid confusing the compiler with shifts that are larger than the width of the type on which they operate. In gcc, such shifts cause incorrect code to be generated." + BytesPerWord = 8 + ifTrue: "64-bit VM" + [Byte0Mask := 16r00000000000000FF. Byte0Shift := 0. + Byte1Mask := 16r000000000000FF00. Byte1Shift := 8. + Byte2Mask := 16r0000000000FF0000. Byte2Shift := 16. + Byte3Mask := 16r00000000FF000000. Byte3Shift := 24. + Byte4Mask := 16r000000FF00000000. Byte4Shift := 32. + Byte5Mask := 16r0000FF0000000000. Byte5Shift := 40. + Byte6Mask := 16r00FF000000000000. Byte6Shift := 48. + Byte7Mask := 16rFF00000000000000. Byte7Shift := 56. + Bytes3to0Mask := 16r00000000FFFFFFFF. + Bytes7to4Mask := 16rFFFFFFFF00000000] + ifFalse: "32-bit VM" + [Byte0Mask := 16r00000000000000FF. Byte0Shift := 0. + Byte1Mask := 16r000000000000FF00. Byte1Shift := 8. + Byte2Mask := 16r0000000000FF0000. Byte2Shift := 16. + Byte3Mask := 16r00000000FF000000. Byte3Shift := 24. + Byte4Mask := nil. Byte4Shift := 0. "unused" + Byte5Mask := nil. Byte5Shift := 0. "unused" + Byte6Mask := nil. Byte6Shift := 0. "unused" + Byte7Mask := nil. Byte7Shift := 0. "unused" + Bytes3to0Mask := nil. "unused" + Bytes7to4Mask := nil "unused"]. + Byte1ShiftNegated := Byte1Shift negated. + Byte3ShiftNegated := Byte3Shift negated. + Byte4ShiftNegated := Byte4Shift negated. + Byte5ShiftNegated := Byte5Shift negated. + Byte7ShiftNegated := Byte7Shift negated. + "N.B. This is *not* output when generating the interpreter file. + It is left to the various sqConfig.h files to define correctly." + VMBIGENDIAN := Smalltalk endianness == #big! Item was added: + ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') ----- + initialize + "CogObjectMemory initialize" + NumFreeLists := 65 "One for each size up to and including 64 slots. One for sizes > 64 slots."! Item was added: + ----- Method: SpurMemoryManager class>>initializeCompactClassIndices (in category 'class initialization') ----- + initializeCompactClassIndices + "Reuse the compact class indices to name known classIndices. + This helps reduce the churn in the interpreters." + "c.f. SpurBootstrap>>defineKnownClassIndices" + ClassLargeNegativeIntegerCompactIndex := 32. + ClassLargePositiveIntegerCompactIndex := 33. + ClassFloatCompactIndex := 34. + + ClassMessageCompactIndex := 35. + ClassMethodContextCompactIndex := 36. + ClassBlockClosureCompactIndex := 37. + + ClassByteArrayCompactIndex := 50. + ClassArrayCompactIndex := 51. + ClassByteStringCompactIndex := 52. + ClassBitmapCompactIndex := 53! Item was added: + ----- Method: SpurMemoryManager class>>initializeSpecialObjectIndices (in category 'initialization') ----- + initializeSpecialObjectIndices + "Initialize indices into specialObjects array." + + NilObject := 0. + FalseObject := 1. + TrueObject := 2. + SchedulerAssociation := 3. + ClassBitmap := 4. + ClassInteger := 5. + ClassByteString := ClassString := 6. "N.B. Actually class ByteString" + ClassArray := 7. + "SmalltalkDictionary := 8." "Do not delete!!" + ClassFloat := 9. + ClassMethodContext := 10. + "ClassBlockContext := 11. unused by the VM" + ClassPoint := 12. + ClassLargePositiveInteger := 13. + TheDisplay := 14. + ClassMessage := 15. + "ClassCompiledMethod := 16. unused by the VM" + TheLowSpaceSemaphore := 17. + ClassSemaphore := 18. + ClassCharacter := 19. + SelectorDoesNotUnderstand := 20. + SelectorCannotReturn := 21. + ProcessSignalingLowSpace := 22. "was TheInputSemaphore" + SpecialSelectors := 23. + CharacterTable := nil. "Must be unused by the VM" + SelectorMustBeBoolean := 25. + ClassByteArray := 26. + "ClassProcess := 27. unused" + CompactClasses := 28. + TheTimerSemaphore := 29. + TheInterruptSemaphore := 30. + SelectorCannotInterpret := 34. + "Was MethodContextProto := 35." + ClassBlockClosure := 36. + "Was BlockContextProto := 37." + ExternalObjectsArray := 38. + ClassMutex := 39. + "Was: ClassTranslatedMethod := 40." + ProcessInExternalCodeTag := 40. + TheFinalizationSemaphore := 41. + ClassLargeNegativeInteger := 42. + + ClassExternalAddress := 43. + ClassExternalStructure := 44. + ClassExternalData := 45. + ClassExternalFunction := 46. + ClassExternalLibrary := 47. + + SelectorAboutToReturn := 48. + SelectorRunWithIn := 49. + + SelectorAttemptToAssign := 50. + "PrimErrTableIndex := 51. in Interpreter class>>initializePrimitiveErrorCodes" + ClassAlien := 52. + SelectorInvokeCallback := 53. + ClassUnsafeAlien := 54. + + ClassWeakFinalizer := 55. + + ForeignCallbackProcess := 56. + + SelectorUnknownBytecode := 57. + SelectorCounterTripped := 58! Item was added: + ----- Method: SpurMemoryManager class>>initializeWithOptions: (in category 'class initialization') ----- + initializeWithOptions: optionsDictionary + "SpurMemoryManager initializeWithOptions: Dictionary new" + + self initBytesPerWord: (optionsDictionary at: #BytesPerWord ifAbsent: [4]). + BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord]. + + self initializeSpecialObjectIndices. + self initializeCompactClassIndices. + self initializePrimitiveErrorCodes.! Item was added: + ----- Method: SpurMemoryManager>>addToFreeList: (in category 'garbage collection') ----- + addToFreeList: freeChunk + | chunkBytes childBytes parent child index | + chunkBytes := self bytesInObject: freeChunk. + index := chunkBytes / self wordSize. + index < NumFreeLists ifTrue: + [self storePointerUnchecked: 0 ofObject: freeChunk withValue: (freeLists at: index). + freeLists at: index put: freeChunk. + ^self]. + self + storePointerUnchecked: self freeChunkNextIndex ofObject: freeChunk withValue: 0; + storePointerUnchecked: self freeChunkParentIndex ofObject: freeChunk withValue: 0; + storePointerUnchecked: self freeChunkSmallerIndex ofObject: freeChunk withValue: 0; + storePointerUnchecked: self freeChunkLargerIndex ofObject: freeChunk withValue: 0. + "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. + Beneath the node are smaller and larger blocks." + parent := 0. + child := freeLists at: 0. + [child ~= 0] whileTrue: + [childBytes := self bytesInObject: child. + childBytes = chunkBytes ifTrue: "size match; add to list at node." + [self storePointerUnchecked: self freeChunkNextIndex + ofObject: freeChunk + withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); + storePointerUnchecked: self freeChunkNextIndex + ofObject: child + withValue: freeChunk. + ^self]. + "walk down the tree" + parent := child. + child := self fetchPointer: (childBytes > chunkBytes + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofObject: child]. + parent = 0 ifTrue: + [self assert: (freeLists at: 0) = 0. + freeLists at: 0 put: freeChunk. + ^self]. + "insert in tree" + self storePointerUnchecked: self freeChunkParentIndex + ofObject: freeChunk + withValue: parent. + self storePointerUnchecked: (childBytes > chunkBytes + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofObject: parent + withValue: freeChunk! Item was added: + ----- Method: SpurMemoryManager>>addressAfter: (in category 'object enumeration') ----- + addressAfter: objOop + "Answer the address immediately following an object." + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'initialization') ----- + adjustAllOopsBy: bytesToShift + "Adjust all oop references by the given number of bytes. This + is done just after reading in an image when the new base + address of the object heap is different from the base address + in the image." + "di 11/18/2000 - return number of objects found" + + | obj | + <inline: false> + bytesToShift ~= 0 ifTrue: + [obj := self firstObject. + [self oop: obj isLessThan: freeStart] whileTrue: + [(self isFreeObject: obj) ifFalse: + [self adjustFieldsAndClassOf: obj by: bytesToShift]. + obj := self objectAfter: obj]]! Item was added: + ----- Method: SpurMemoryManager>>adjustFieldsAndClassOf:by: (in category 'initialization') ----- + adjustFieldsAndClassOf: oop by: offsetBytes + "Adjust all pointers in this object by the given offset." + self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>allObjectsDo: (in category 'debug support') ----- + allObjectsDo: aBlock + <doNotGenerate> + | prevObj prevPrevObj objOop | + prevPrevObj := prevObj := nil. + objOop := self firstObject. + [self assert: objOop \\ self allocationUnit = 0. + objOop < freeStart] whileTrue: + [(self isFreeObject: objOop) ifFalse: + [aBlock value: objOop]. + prevPrevObj := prevObj. + prevObj := objOop. + objOop := self objectAfter: objOop]. + prevPrevObj class. + prevObj class! Item was added: + ----- Method: SpurMemoryManager>>allocateMemoryOfSize: (in category 'simulation') ----- + allocateMemoryOfSize: limit + <doNotGenerate> + memory := (self endianness == #little + ifTrue: [LittleEndianBitmap] + ifFalse: [Bitmap]) new: (limit roundUpTo: 8). + freeStart := startOfMemory := 0. + scavengeThreshold := newSpaceLimit := memory size * 4 "Bitmap is a 4-byte per word array"! Item was added: + ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') ----- + allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes + <doNotGenerate> + self assert: (memoryBytes \\ self allocationUnit = 0 + and: [newSpaceBytes \\ self allocationUnit = 0 + and: [codeBytes \\ self allocationUnit = 0]]). + memory := (self endianness == #little + ifTrue: [LittleEndianBitmap] + ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4. + startOfMemory := codeBytes. + endOfMemory := memoryBytes + newSpaceBytes + codeBytes. + "leave newSpace empty for the bootstrap" + freeStart := newSpaceBytes + startOfMemory. + newSpaceStart := startOfMemory. + newSpaceLimit := newSpaceBytes + startOfMemory. + scavengeThreshold := memory size * 4 "Bitmap is a 4-byte per word array"! Item was added: + ----- Method: SpurMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- + allocateSlots: numSlots format: formatField classIndex: classIndex + self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>allocationUnit (in category 'allocation') ----- + allocationUnit + "All objects are a multiple of 8 bytes in length" + ^8! Item was added: + ----- Method: SpurMemoryManager>>arrayClassIndexPun (in category 'class table') ----- + arrayClassIndexPun + "Class puns are class indices not used by any class. There is an entry + for the pun that refers to the notional class of objects with this class + index. But because the index doesn't match the class it won't show up + in allInstances, hence hiding the object with a pun as its class index. + The puns occupy indices 16 through 31." + ^16! Item was added: + ----- Method: SpurMemoryManager>>arrayFormat (in category 'header format') ----- + arrayFormat + ^2! Item was added: + ----- Method: SpurMemoryManager>>baseHeader: (in category 'header access') ----- + baseHeader: obj + ^self longLongAt: obj! Item was added: + ----- Method: SpurMemoryManager>>baseHeaderSize (in category 'header format') ----- + baseHeaderSize + "Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow), + 16 bytes otherwise (slot size in preceeding word)." + ^8! Item was added: + ----- Method: SpurMemoryManager>>bytesPerSlot (in category 'header format') ----- + bytesPerSlot + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>characterObjectOf: (in category 'object access') ----- + characterObjectOf: characterCode + ^characterCode << self numTagBits + self characterTag! Item was added: + ----- Method: SpurMemoryManager>>characterTag (in category 'object access') ----- + characterTag + ^2! Item was added: + ----- Method: SpurMemoryManager>>checkCompactIndex:isClass:named: (in category 'initialization') ----- + checkCompactIndex: classIndex isClass: specialIndex named: name + "Check that a class the VM assumes is compact has the right index." + <inline: true> "macrofication of the name arg in invalidCompactClassError only works if this method is inlined so the name is a string literal not a parameter" + (classIndex ~= 0 + and: [(self splObj: specialIndex) ~= (self knownClassAtIndex: classIndex)]) ifTrue: + [self invalidCompactClassError: name]! Item was added: + ----- Method: SpurMemoryManager>>classAtIndex: (in category 'class table') ----- + classAtIndex: classIndex + | majorIndex minorIndex page | + majorIndex := classIndex >> self classTableMajorIndexShift. + minorIndex := classIndex bitAnd: self classTableMinorIndexMask. + self assert: (majorIndex between: 0 and: (self numSlotsOf: classTableRootObj) - 1). + page := self fetchPointer: majorIndex ofObject: classTableRootObj. + ^self fetchPointer: minorIndex ofObject: page! Item was added: + ----- Method: SpurMemoryManager>>classIndexMask (in category 'header format') ----- + classIndexMask + "22-bit class mask => ~ 4M classes" + ^16r3fffff! Item was added: + ----- Method: SpurMemoryManager>>classIndexOf: (in category 'header access') ----- + classIndexOf: objOop + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>classTableMajorIndexShift (in category 'class table') ----- + classTableMajorIndexShift + "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages" + ^10! Item was added: + ----- Method: SpurMemoryManager>>classTableMinorIndexMask (in category 'class table') ----- + classTableMinorIndexMask + "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages" + "self basicNew classTableMinorIndexMask" + ^1 << self classTableMajorIndexShift - 1! Item was added: + ----- Method: SpurMemoryManager>>classTablePageSize (in category 'class table') ----- + classTablePageSize + "1024 entries per page (2^10); 22 bit classIndex implies 2^12 pages" + "self basicNew classTablePageSize" + ^1 << self classTableMajorIndexShift! Item was added: + ----- Method: SpurMemoryManager>>classTableRootObj (in category 'accessing') ----- + classTableRootObj + "For mapInterpreterOops & bootstrap" + ^classTableRootObj! Item was added: + ----- Method: SpurMemoryManager>>classTableRootObj: (in category 'accessing') ----- + classTableRootObj: anOop + "For mapInterpreterOops" + classTableRootObj := anOop. + classTableFirstPage := self fetchPointer: 0 ofObject: classTableRootObj! Item was added: + ----- Method: SpurMemoryManager>>coInterpreter: (in category 'simulation') ----- + coInterpreter: aCoInterpreter + <doNotGenerate> + coInterpreter := aCoInterpreter! Item was added: + ----- Method: SpurMemoryManager>>ensureBehaviorHash: (in category 'class table') ----- + ensureBehaviorHash: aBehavior + | newHash err | + self assert: (self isIntegerObject: aBehavior) not. + (newHash := self hashBitsOf: aBehavior) = 0 ifTrue: + [(err := self enterIntoClassTable: aBehavior) ~= 0 ifTrue: + [^err negated]. + newHash := self hashBitsOf: aBehavior]. + ^newHash! Item was added: + ----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') ----- + enterIntoClassTable: aBehavior + "Enter aBehavior into the class table and answer 0. Otherwise answer a primitive failure code." + self shouldBeImplemented! Item was added: + ----- Method: SpurMemoryManager>>falseObject (in category 'accessing') ----- + falseObject + ^falseObj! Item was added: + ----- Method: SpurMemoryManager>>falseObject: (in category 'accessing') ----- + falseObject: anOop + "For mapInterpreterOops" + falseObj := anOop! Item was added: + ----- Method: SpurMemoryManager>>fetchLong32:ofObject: (in category 'object access') ----- + fetchLong32: fieldIndex ofObject: oop + "index by 32-bit units, and return a 32-bit value. Intended to replace fetchWord:ofObject:" + + ^self long32At: oop + self baseHeaderSize + (fieldIndex << 2)! Item was added: + ----- Method: SpurMemoryManager>>firstCompiledMethodFormat (in category 'header format') ----- + firstCompiledMethodFormat + ^24! Item was added: + ----- Method: SpurMemoryManager>>firstObject (in category 'object enumeration') ----- + firstObject + "Return the first object or free chunk in the heap." + + ^nilObj! Item was added: + ----- Method: SpurMemoryManager>>formatMask (in category 'header format') ----- + formatMask + ^16r1f! Item was added: + ----- Method: SpurMemoryManager>>formatOf: (in category 'object access') ----- + formatOf: objOop + "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,7,8 unused + 9 (?) 64-bit indexable + 10 - 11 32-bit indexable + 12 - 15 16-bit indexable + 16 - 23 byte indexable + 24 - 31 compiled method" + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>formatOfHeader: (in category 'object access') ----- + formatOfHeader: header + <var: 'header' type: #usqLong> + "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,7,8 unused + 9 (?) 64-bit indexable + 10 - 11 32-bit indexable + 12 - 15 16-bit indexable + 16 - 23 byte indexable + 24 - 31 compiled method" + ^header >> self formatShift bitAnd: self formatMask! Item was added: + ----- Method: SpurMemoryManager>>formatShift (in category 'header format') ----- + formatShift + ^24! Item was added: + ----- Method: SpurMemoryManager>>freeChunkLargerIndex (in category 'garbage collection') ----- + freeChunkLargerIndex + ^3! Item was added: + ----- Method: SpurMemoryManager>>freeChunkNextIndex (in category 'garbage collection') ----- + freeChunkNextIndex + ^0! Item was added: + ----- Method: SpurMemoryManager>>freeChunkParentIndex (in category 'garbage collection') ----- + freeChunkParentIndex + ^1! Item was added: + ----- Method: SpurMemoryManager>>freeChunkSmallerIndex (in category 'garbage collection') ----- + freeChunkSmallerIndex + ^2! Item was added: + ----- Method: SpurMemoryManager>>freeStart (in category 'accessing') ----- + freeStart + ^freeStart! Item was added: + ----- Method: SpurMemoryManager>>headerForSlots:format:classIndex: (in category 'header format') ----- + headerForSlots: numSlots format: formatField classIndex: classIndex + "The header format in LSB is + MSB: | 8: slotSize | (on a byte boundary) + | 2 bits | + | 22: identityHash | (on a word boundary) + | 3 bits | + | 5: format | (on a byte boundary) + | 2 bits | + | 22: classIndex | (on a word boundary) : LSB + The remaining bits (7) need to be used for + isGrey + isMarked + isRemembered + isPinned + isImmutable + leaving 2 unused bits." + ^ (numSlots << self numSlotsFullShift) + + (formatField << self formatShift) + + classIndex! Item was added: + ----- Method: SpurMemoryManager>>identityHashHalfWordMask (in category 'header format') ----- + identityHashHalfWordMask + ^16r3fffff! Item was added: + ----- Method: SpurMemoryManager>>indexablePointersFormat (in category 'header format') ----- + indexablePointersFormat + ^3! Item was added: + ----- Method: SpurMemoryManager>>initFreeChunkWithBytes:at: (in category 'garbage collection') ----- + initFreeChunkWithBytes: numBytes at: address + | numSlots | + self assert: numBytes \\ self allocationUnit = 0. + numSlots := numBytes >> self shiftForWord + - (numBytes >= (self numSlotsMask << self shiftForWord) + ifTrue: [self baseHeaderSize + self baseHeaderSize / self wordSize] + ifFalse: [self baseHeaderSize / self wordSize]). + ^self initFreeChunkWithSlots: numSlots at: address! Item was added: + ----- Method: SpurMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- + initFreeChunkWithSlots: numSlots at: address + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- + initialize + freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0)! Item was added: + ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- + initializeObjectMemory: bytesToShift + "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." + "Assume: image reader initializes the following variables: + memory + memoryLimit + specialObjectsOop + lastHash + " + <inline: false> + "image may be at a different address; adjust oops for new location" + self adjustAllOopsBy: bytesToShift. + + self initializeOldSpaceFirstFree: endOfOldSpace. "initializes endOfMemory, freeStart" + + specialObjectsOop := specialObjectsOop + bytesToShift. + + "heavily used special objects" + nilObj := self splObj: NilObject. + falseObj := self splObj: FalseObject. + trueObj := self splObj: TrueObject. + + "rootTableCount := 0. + rootTableOverflowed := false. + lowSpaceThreshold := 0. + signalLowSpace := false. + compStart := 0. + compEnd := 0. + fwdTableNext := 0. + fwdTableLast := 0. + remapBufferCount := 0. + tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold"" + growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing"" + shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking"" + + ""garbage collection statistics"" + statFullGCs := 0. + statFullGCUsecs := 0. + statIncrGCs := 0. + statIncrGCUsecs := 0. + statTenures := 0. + statRootTableOverflows := 0. + statGrowMemory := 0. + statShrinkMemory := 0. + forceTenureFlag := 0. + gcBiasToGrow := 0. + gcBiasToGrowGCLimit := 0. + extraRootCount := 0."! Item was added: + ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'garbage collection') ----- + initializeOldSpaceFirstFree: startOfFreeOldSpace + <var: 'startOfFreeOldSpace' type: #usqLong> + | freeOldStart freeChunk | + <var: 'freeOldStart' type: #usqLong> + 0 to: NumFreeLists - 1 do: + [:i| freeLists at: i put: 0]. + freeOldStart := startOfFreeOldSpace. + [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: + [freeChunk := self initFreeChunkWithSlots: (2 raisedTo: 32) / self wordSize at: freeOldStart. + self addToFreeList: freeChunk. + freeOldStart := self addressAfter: freeChunk]. + freeChunk := self initFreeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. + self addToFreeList: freeChunk. + self assert: (self addressAfter: freeChunk) = endOfMemory! Item was added: + ----- Method: SpurMemoryManager>>initializePostBootstrap (in category 'simulation') ----- + initializePostBootstrap + "The heap has just been bootstrapped into a modified newSpace occupying all of memory above newSPace (and the codeZone). + Put things back to some kind of normalicy." + endOfOldSpace := freeStart. + freeStart := newSpaceStart! Item was added: + ----- Method: SpurMemoryManager>>isCompiledMethod: (in category 'object testing') ----- + isCompiledMethod: objOop + "Answer whether the argument object is of compiled method format" + <api> + ^(self formatOf: objOop) >= 24! Item was added: + ----- Method: SpurMemoryManager>>isFreeObject: (in category 'header access') ----- + isFreeObject: objOop + ^(self classIndexOf: objOop) = 0! Item was added: + ----- Method: SpurMemoryManager>>isImmediate: (in category 'object testing') ----- + isImmediate: oop + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>isPointersNonImm: (in category 'object testing') ----- + isPointersNonImm: objOop + ^(self formatOf: objOop) <= 5! Item was added: + ----- Method: SpurMemoryManager>>knownClassAtIndex: (in category 'class table') ----- + knownClassAtIndex: classIndex + self assert: (classIndex between: 1 and: self classTablePageSize). + ^self fetchPointer: classIndex ofObject: classTableFirstPage! Item was added: + ----- Method: SpurMemoryManager>>lastPointerFormat (in category 'header format') ----- + lastPointerFormat + ^5! Item was added: + ----- Method: SpurMemoryManager>>lastPointerOf: (in category 'object enumeration') ----- + lastPointerOf: obj + "Answer the byte offset of the last pointer field of the given object. + Works with CompiledMethods, as well as ordinary objects." + <api> + <inline: true> + <asmLabel: false> + | fmt header contextSize numLiterals | + <var: 'header' type: #usqLong> + header := self baseHeader: obj. + fmt := self formatOfHeader: header. + fmt <= self lastPointerFormat ifTrue: + [(fmt = self indexablePointersFormat + and: [self isContextHeader: header]) ifTrue: + ["contexts end at the stack pointer" + contextSize := coInterpreter fetchStackPointerOf: obj. + ^CtxtTempFrameStart + contextSize * BytesPerOop]. + ^(self numSlotsOf: obj) * BytesPerOop "all pointers"]. + fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" + + "CompiledMethod: contains both pointers and bytes" + numLiterals := coInterpreter literalCountOf: obj. + ^numLiterals + LiteralStart * BytesPerOop! Item was added: + ----- Method: SpurMemoryManager>>nilFieldsOf: (in category 'primitive support') ----- + nilFieldsOf: obj + 0 to: (self numSlotsOf: obj) - 1 do: + [:i| + self storePointerUnchecked: i ofObject: obj withValue: nilObj]! Item was added: + ----- Method: SpurMemoryManager>>nilObject (in category 'accessing') ----- + nilObject + ^nilObj! Item was added: + ----- Method: SpurMemoryManager>>nilObject: (in category 'accessing') ----- + nilObject: anOop + "For mapInterpreterOops" + nilObj := anOop! Item was added: + ----- Method: SpurMemoryManager>>numSlotsFullShift (in category 'header format') ----- + numSlotsFullShift + ^56! Item was added: + ----- Method: SpurMemoryManager>>numSlotsHalfShift (in category 'header format') ----- + numSlotsHalfShift + ^24! Item was added: + ----- Method: SpurMemoryManager>>numSlotsMask (in category 'header format') ----- + numSlotsMask + "8-bit slot count + max 64-bit small obj size 254 * 8 = 2032 bytes + max 32-bit small obj size 254 * 4 = 1016 bytes" + ^255! Item was added: + ----- Method: SpurMemoryManager>>numSlotsOf: (in category 'object access') ----- + numSlotsOf: objOop + <returnTypeC: #usqInt> + | halfHeader numSlots | + self flag: #endianness. + halfHeader := self longAt: objOop + 4. + numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. + ^numSlots = self numSlotsMask + ifTrue: [self longAt: objOop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty" + ifFalse: [numSlots]! Item was added: + ----- Method: SpurMemoryManager>>numTagBits (in category 'object access') ----- + numTagBits + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>objectAfter: (in category 'object enumeration') ----- + objectAfter: objOop + "Object parsing. + 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following + an object doesn't have a saturated size field it must be a single-header object. If the word following + does have a saturated slotSize it must be the overflow size word." + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>overflowSlotsMask (in category 'header format') ----- + overflowSlotsMask + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>setHashBitsOf:to: (in category 'header access') ----- + setHashBitsOf: objOop to: hash + self assert: (hash between: 0 and: self identityHashHalfWordMask). + self longAt: objOop + put: ((self longAt: objOop) bitClear: self identityHashHalfWordMask) + hash! Item was added: + ----- Method: SpurMemoryManager>>specialObjectsOop (in category 'accessing') ----- + specialObjectsOop + ^specialObjectsOop! Item was added: + ----- Method: SpurMemoryManager>>specialObjectsOop: (in category 'accessing') ----- + specialObjectsOop: anObject + "For mapInterpreterOops" + specialObjectsOop := anObject! Item was added: + ----- Method: SpurMemoryManager>>splObj: (in category 'interpreter access') ----- + splObj: index + <api> + <inline: true> + "Return one of the objects in the specialObjectsArray" + ^self fetchPointer: index ofObject: specialObjectsOop! Item was added: + ----- Method: SpurMemoryManager>>startOfMemory (in category 'accessing') ----- + startOfMemory + "Return the start of object memory. This is immediately after the native code zone. + N.B. the stack zone is alloca'ed. Use a macro so as not to punish the debug VM." + <cmacro: '() heapBase'> + <returnTypeC: #usqInt> + ^coInterpreter ifNil: [startOfMemory] ifNotNil: [coInterpreter heapBase]! Item was added: + ----- Method: SpurMemoryManager>>startOfMemory: (in category 'simulation') ----- + startOfMemory: value + startOfMemory := value. + (freeStart isNil or: [freeStart < value]) ifTrue: + [freeStart := value]! Item was added: + ----- Method: SpurMemoryManager>>storeLong32:ofObject:withValue: (in category 'object access') ----- + storeLong32: fieldIndex ofObject: obj withValue: valueWord + ^self long32At: obj + self baseHeaderSize + (fieldIndex << 2) put: valueWord! Item was added: + ----- Method: SpurMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') ----- + storePointer: fieldIndex ofObject: oop withValue: valuePointer + "Note must check here for stores of young objects into old ones." + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>storePointerUnchecked:ofObject:withValue: (in category 'object access') ----- + storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>trueObject (in category 'accessing') ----- + trueObject + ^trueObj! Item was added: + ----- Method: SpurMemoryManager>>trueObject: (in category 'accessing') ----- + trueObject: anOop + "For mapInterpreterOops" + trueObj := anOop! Item was added: + ----- Method: SpurMemoryManager>>weakArrayClassIndexPun (in category 'class table') ----- + weakArrayClassIndexPun + "Class puns are class indices not used by any class. There is an entry + for the pun that refers to the notional class of objects with this class + index. But because the index doesn't match the class it won't show up + in allInstances, hence hiding the object with a pun as its class index. + The puns occupy indices 16 through 31." + ^17! Item was added: + ----- Method: SpurMemoryManager>>weakArrayFormat (in category 'header format') ----- + weakArrayFormat + ^4! Item was changed: InterpreterPrimitives subclass: #StackInterpreter instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClass highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBits interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex' classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable' + poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets' - poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets' category: 'VMMaker-Interpreter'! !StackInterpreter commentStamp: '<historical>' prior: 0! This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. This VM supports Closures but *not* old-style BlockContexts. It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms. The VM does not use Contexts directly. Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image. There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the…. The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations. A send establishes a new frame in the current stack page, a return returns to the previous frame. This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return. Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together). Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died). A married context is specially marked (more details in the code) and refers to its frame. Likewise a married frame is specially marked and refers to its context. In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case. NOTE: Here follows a list of things to be borne in mind when working on this code, or when making changes for the future. 1. There are a number of things that should be done the next time we plan to release a completely incompatible image format. These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:. Also, contexts should be given a special format code (see next item). 2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the SystemTracer. A better solution would be to reserve one of the format codes for Contexts only. 3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. 4. Note that 0 is used in a couple of places as an impossible oop. This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment). The places include the method cache and the at cache. 5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT 6. If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.! Item was changed: Object subclass: #VMClass instanceVariableNames: '' classVariableNames: 'DefaultBase' + poolDictionaries: 'VMBasicConstants VMObjectIndices' - poolDictionaries: 'VMBasicConstants' category: 'VMMaker-Support'! VMClass class instanceVariableNames: 'timeStamp'! !VMClass commentStamp: '<historical>' prior: 0! I am an abstract superclass for all classes in the VM that want to maintain a source timeStamp.! VMClass class instanceVariableNames: 'timeStamp'! Item was added: + ----- Method: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') ----- + initializePrimitiveErrorCodes + "Define the VM's primitive error codes. N.B. these are + replicated in platforms/Cross/vm/sqVirtualMachine.h." + "VMClass initializePrimitiveErrorCodes" + | pet | + PrimErrTableIndex := 51. "Zero-relative" + "See SmalltalkImage>>recreateSpecialObjectsArray for the table definition. + If the table exists and is large enough the corresponding entry is returned as + the primitive error, otherwise the error is answered numerically." + pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()]. + pet isArray ifFalse: [pet := #()]. + PrimNoErr := 0. "for helper methods that need to answer success or an error code." + PrimErrGenericFailure := pet indexOf: nil ifAbsent: 1. + PrimErrBadReceiver := pet indexOf: #'bad receiver' ifAbsent: 2. + PrimErrBadArgument := pet indexOf: #'bad argument' ifAbsent: 3. + PrimErrBadIndex := pet indexOf: #'bad index' ifAbsent: 4. + PrimErrBadNumArgs := pet indexOf: #'bad number of arguments' ifAbsent: 5. + PrimErrInappropriate := pet indexOf: #'inappropriate operation' ifAbsent: 6. + PrimErrUnsupported := pet indexOf: #'unsupported operation' ifAbsent: 7. + PrimErrNoModification := pet indexOf: #'no modification' ifAbsent: 8. + PrimErrNoMemory := pet indexOf: #'insufficient object memory' ifAbsent: 9. + PrimErrNoCMemory := pet indexOf: #'insufficient C memory' ifAbsent: 10. + PrimErrNotFound := pet indexOf: #'not found' ifAbsent: 11. + PrimErrBadMethod := pet indexOf: #'bad method' ifAbsent: 12. + PrimErrNamedInternal := pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13. + PrimErrObjectMayMove := pet indexOf: #'object may move' ifAbsent: 14. + PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15! Item was added: + VMBasicConstants subclass: #VMSqueakClassIndices + instanceVariableNames: '' + classVariableNames: 'ClassArrayCompactIndex ClassBitmapCompactIndex ClassBlockClosureCompactIndex ClassBlockContextCompactIndex ClassByteArrayCompactIndex ClassByteStringCompactIndex ClassFloatCompactIndex ClassLargeNegativeIntegerCompactIndex ClassLargePositiveIntegerCompactIndex ClassMessageCompactIndex ClassMethodContextCompactIndex' + poolDictionaries: '' + category: 'VMMaker-Interpreter'! Item was changed: VMBasicConstants subclass: #VMSqueakV3ObjectRepresentationConstants instanceVariableNames: '' + classVariableNames: 'AllButTypeMask CompactClassMask HashBitsOffset HashMaskUnshifted HeaderTypeShort HeaderTypeSizeAndClass ImmediateTagMask ImmutabilityBit LongSizeMask MarkBit RootBit Size4Bit SizeMask SmallIntegerShift TypeMask' - classVariableNames: 'AllButTypeMask ClassArrayCompactIndex ClassBlockClosureCompactIndex ClassBlockContextCompactIndex ClassByteStringCompactIndex ClassFloatCompactIndex ClassLargeNegativeIntegerCompactIndex ClassLargePositiveIntegerCompactIndex ClassMethodContextCompactIndex CompactClassMask HashBitsOffset HashMaskUnshifted HeaderTypeShort HeaderTypeSizeAndClass ImmediateTagMask ImmutabilityBit LongSizeMask MarkBit RootBit Size4Bit SizeMask SmallIntegerShift TypeMask' poolDictionaries: '' category: 'VMMaker-Interpreter'! !VMSqueakV3ObjectRepresentationConstants commentStamp: '<historical>' prior: 0! I am a shared pool for the constants that define the Squeak V3 object representation shared between the object memories (e.g. ObjectMemory, NewObjectMemory), the interpreters (e.g. StackInterpreter, CoInterpreter) and the object representations (e.g. ObjectRepresentationForSqueakV3). self ensureClassPool self classPool declare: #AllButTypeMask from: VMObjectOffsets classPool (ObjectMemory classPool keys select: [:k| k includesSubString: 'Compact']) do: [:k| self classPool declare: k from: ObjectMemory classPool]!

1 0

VM Maker: VMMaker.oscog-eem.342.mcz
by commits＠source.squeak.org 03 Sep '13

03 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.342.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.342 Author: eem Time: 2 September 2013, 4:14:17.875 pm UUID: a317db9c-c8be-424e-800c-8525d0bfe8fa Ancestors: VMMaker.oscog-eem.341 Add oldSpace freeList support (still no allocInOldSpace). Rename slotSize to numSlots to avoid confusion with misnamed slotSizeOf: (should be elementCountOf:). =============== Diff against VMMaker.oscog-eem.341 =============== Item was changed: ----- Method: CMM32LSBSimulator>>headerForSlots:format:classIndex: (in category 'header format') ----- headerForSlots: numSlots format: formatField classIndex: classIndex "The header format in LSB is MSB: | 2 bits | | 22: identityHash | | 8: slotSize | | 3 bits | | 5: format | | 2 bits | | 22: classIndex | : LSB" + self assert: (numSlots between: 0 and: self numSlotsMask). - self assert: (numSlots between: 0 and: self slotSizeMask). self assert: (formatField between: 0 and: 31). self assert: (classIndex between: 0 and: 16r3fffff). ^super headerForSlots: numSlots format: formatField classIndex: classIndex! Item was added: + ----- Method: CogMemoryManager>>addToFreeList: (in category 'garbage collection') ----- + addToFreeList: freeChunk + | chunkBytes childBytes parent child index | + chunkBytes := self bytesInObject: freeChunk. + index := chunkBytes / self wordSize. + index < NumFreeLists ifTrue: + [self storePointerUnchecked: 0 ofObject: freeChunk withValue: (freeLists at: index). + freeLists at: index put: freeChunk. + ^self]. + self + storePointerUnchecked: self freeChunkNextIndex ofObject: freeChunk withValue: 0; + storePointerUnchecked: self freeChunkParentIndex ofObject: freeChunk withValue: 0; + storePointerUnchecked: self freeChunkSmallerIndex ofObject: freeChunk withValue: 0; + storePointerUnchecked: self freeChunkLargerIndex ofObject: freeChunk withValue: 0. + "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. + Beneath the node are smaller and larger blocks." + parent := 0. + child := freeLists at: 0. + [child ~= 0] whileTrue: + [childBytes := self bytesInObject: child. + childBytes = chunkBytes ifTrue: "size match; add to list at node." + [self storePointerUnchecked: self freeChunkNextIndex + ofObject: freeChunk + withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); + storePointerUnchecked: self freeChunkNextIndex + ofObject: child + withValue: freeChunk. + ^self]. + "walk down the tree" + parent := child. + child := self fetchPointer: (childBytes > chunkBytes + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofObject: child]. + parent = 0 ifTrue: + [self assert: (freeLists at: 0) = 0. + freeLists at: 0 put: freeChunk. + ^self]. + "insert in tree" + self storePointerUnchecked: self freeChunkParentIndex + ofObject: freeChunk + withValue: parent. + self storePointerUnchecked: (childBytes > chunkBytes + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofObject: parent + withValue: freeChunk! Item was removed: - ----- Method: CogMemoryManager>>baseSlotSizeOf: (in category 'object access') ----- - baseSlotSizeOf: oop - <returnTypeC: #usqInt> - | halfHeader slotSize | - self flag: #endianness. - halfHeader := self longAt: oop + 4. - slotSize := halfHeader >> self slotSizeHalfShift bitAnd: self slotSizeMask. - ^slotSize = self slotSizeMask - ifTrue: [self longAt: oop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty" - ifFalse: [slotSize]! Item was added: + ----- Method: CogMemoryManager>>freeChunkLargerIndex (in category 'garbage collection') ----- + freeChunkLargerIndex + ^3! Item was added: + ----- Method: CogMemoryManager>>freeChunkNextIndex (in category 'garbage collection') ----- + freeChunkNextIndex + ^0! Item was added: + ----- Method: CogMemoryManager>>freeChunkParentIndex (in category 'garbage collection') ----- + freeChunkParentIndex + ^1! Item was added: + ----- Method: CogMemoryManager>>freeChunkSmallerIndex (in category 'garbage collection') ----- + freeChunkSmallerIndex + ^2! Item was changed: ----- Method: CogMemoryManager>>headerForSlots:format:classIndex: (in category 'header format') ----- headerForSlots: numSlots format: formatField classIndex: classIndex "The header format in LSB is MSB: | 8: slotSize | (on a byte boundary) | 2 bits | | 22: identityHash | (on a word boundary) | 3 bits | | 5: format | (on a byte boundary) | 2 bits | | 22: classIndex | (on a word boundary) : LSB The remaining bits (7) need to be used for isGrey isMarked isRemembered isPinned isImmutable leaving 2 unused bits." + ^ (numSlots << self numSlotsFullShift) - ^ (numSlots << self slotSizeFullShift) + (formatField << self formatShift) + classIndex! Item was added: + ----- Method: CogMemoryManager>>initFreeChunkWithBytes:at: (in category 'garbage collection') ----- + initFreeChunkWithBytes: numBytes at: address + | numSlots | + self assert: numBytes \\ self allocationUnit = 0. + numSlots := numBytes >> self shiftForWord + - (numBytes >= (self numSlotsMask << self shiftForWord) + ifTrue: [self baseHeaderSize + self baseHeaderSize / self wordSize] + ifFalse: [self baseHeaderSize / self wordSize]). + ^self initFreeChunkWithSlots: numSlots at: address! Item was changed: ----- Method: CogMemoryManager>>initialize (in category 'initialization') ----- initialize + freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0)! - freeLists := Array new: NumFreeLists. "gets an extra element in C"! Item was changed: ----- Method: CogMemoryManager>>initializeOldSpaceFirstFree: (in category 'garbage collection') ----- initializeOldSpaceFirstFree: startOfFreeOldSpace <var: 'startOfFreeOldSpace' type: #usqLong> | freeOldStart freeChunk | <var: 'freeOldStart' type: #usqLong> + 0 to: NumFreeLists - 1 do: + [:i| freeLists at: i put: 0]. - 1 to: NumFreeLists do: - [:i| freeLists at: i put: nil]. freeOldStart := startOfFreeOldSpace. [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: [freeChunk := self initFreeChunkWithSlots: (2 raisedTo: 32) / self wordSize at: freeOldStart. self addToFreeList: freeChunk. freeOldStart := self addressAfter: freeChunk]. + freeChunk := self initFreeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. + self addToFreeList: freeChunk. + self assert: (self addressAfter: freeChunk) = endOfMemory! - freeChunk := self initFreeChunkWithSlots: endOfMemory - freeOldStart / self wordSize at: freeOldStart. - self addToFreeList: freeChunk! Item was changed: ----- Method: CogMemoryManager>>lastPointerOf: (in category 'object enumeration') ----- + lastPointerOf: obj - lastPointerOf: oop "Answer the byte offset of the last pointer field of the given object. Works with CompiledMethods, as well as ordinary objects." <api> <inline: true> <asmLabel: false> | fmt header contextSize numLiterals | <var: 'header' type: #usqLong> + header := self baseHeader: obj. - header := self baseHeader: oop. fmt := self formatOfHeader: header. fmt <= self lastPointerFormat ifTrue: [(fmt = self indexablePointersFormat and: [self isContextHeader: header]) ifTrue: ["contexts end at the stack pointer" + contextSize := coInterpreter fetchStackPointerOf: obj. - contextSize := coInterpreter fetchStackPointerOf: oop. ^CtxtTempFrameStart + contextSize * BytesPerOop]. + ^(self numSlotsOf: obj) * BytesPerOop "all pointers"]. - ^(self baseSlotSizeOf: oop) * BytesPerOop "all pointers"]. fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" "CompiledMethod: contains both pointers and bytes" + numLiterals := coInterpreter literalCountOf: obj. - numLiterals := coInterpreter literalCountOf: oop. ^numLiterals + LiteralStart * BytesPerOop! Item was changed: ----- Method: CogMemoryManager>>nilFieldsOf: (in category 'primitive support') ----- nilFieldsOf: obj + 0 to: (self numSlotsOf: obj) - 1 do: - 0 to: (self baseSlotSizeOf: obj) - 1 do: [:i| self storePointerUnchecked: i ofObject: obj withValue: nilObj]! Item was added: + ----- Method: CogMemoryManager>>numSlotsFullShift (in category 'header format') ----- + numSlotsFullShift + ^56! Item was added: + ----- Method: CogMemoryManager>>numSlotsHalfShift (in category 'header format') ----- + numSlotsHalfShift + ^24! Item was added: + ----- Method: CogMemoryManager>>numSlotsMask (in category 'header format') ----- + numSlotsMask + "8-bit slot count + max 64-bit small obj size 254 * 8 = 2032 bytes + max 32-bit small obj size 254 * 4 = 1016 bytes" + ^255! Item was added: + ----- Method: CogMemoryManager>>numSlotsOf: (in category 'object access') ----- + numSlotsOf: objOop + <returnTypeC: #usqInt> + | halfHeader numSlots | + self flag: #endianness. + halfHeader := self longAt: objOop + 4. + numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. + ^numSlots = self numSlotsMask + ifTrue: [self longAt: objOop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty" + ifFalse: [numSlots]! Item was removed: - ----- Method: CogMemoryManager>>slotSizeFullShift (in category 'header format') ----- - slotSizeFullShift - ^56! Item was removed: - ----- Method: CogMemoryManager>>slotSizeHalfShift (in category 'header format') ----- - slotSizeHalfShift - ^24! Item was removed: - ----- Method: CogMemoryManager>>slotSizeMask (in category 'header format') ----- - slotSizeMask - "8-bit slot size: - max 64-bit small obj size 254 * 8 = 2032 bytes - max 32-bit small obj size 254 * 4 = 1016 bytes" - ^255! Item was changed: ----- Method: CogMemoryManager32Bits>>addressAfter: (in category 'object enumeration') ----- addressAfter: objOop "Answer the address immediately following an object." + | numSlots slotBytes | + numSlots := self numSlotsOf: objOop. + slotBytes := numSlots = 0 - | rawSlotSize slotBytes | - rawSlotSize := self baseSlotSizeOf: objOop. - slotBytes := rawSlotSize = 0 ifTrue: [self allocationUnit] + ifFalse: [numSlots + (numSlots bitAnd: 1) << self shiftForWord]. - ifFalse: [rawSlotSize + (rawSlotSize bitAnd: 1) << self shiftForWord]. ^objOop + self baseHeaderSize + slotBytes! Item was changed: ----- Method: CogMemoryManager32Bits>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | numBytes newObj | + "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), - "Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow), 16 bytes otherwise (slot size in preceeding word). Objects always have at least one slot, for the forwarding pointer, and are multiples of 8 bytes in length." + numSlots >= self numSlotsMask - numSlots >= self slotSizeMask ifTrue: [newObj := freeStart + self baseHeaderSize. numBytes := self baseHeaderSize + self baseHeaderSize "double header" + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" ifFalse: [newObj := freeStart. numBytes := self baseHeaderSize "single header" + (numSlots <= 1 ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" self assert: numBytes \\ self allocationUnit = 0. freeStart + numBytes > scavengeThreshold ifTrue: [freeStart + numBytes > newSpaceLimit ifTrue: [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. self scheduleScavenge]. + numSlots >= self numSlotsMask - numSlots >= self slotSizeMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: freeStart put: numSlots. + self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] - self longAt: freeStart + 4 put: self slotSizeMask << self slotSizeHalfShift. - self longLongAt: newObj put: (self headerForSlots: self slotSizeMask format: formatField classIndex: classIndex)] ifFalse: [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. self assert: numBytes \\ self allocationUnit = 0. self assert: newObj \\ self allocationUnit = 0. freeStart := freeStart + numBytes. ^newObj! Item was added: + ----- Method: CogMemoryManager32Bits>>bytesInObject: (in category 'object enumeration') ----- + bytesInObject: objOop + "Answer the total number of bytes in an object including header and possible overflow size header." + | halfHeader headerNumSlots numSlots | + self flag: #endianness. + halfHeader := self longAt: objOop + 4. + headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. + numSlots := headerNumSlots = self numSlotsMask + ifTrue: [self longAt: objOop - self baseHeaderSize] + ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]]. + ^numSlots + (numSlots bitAnd: 1) << self shiftForWord + + (headerNumSlots = self numSlotsMask + ifTrue: [self baseHeaderSize + self baseHeaderSize] + ifFalse: [self baseHeaderSize])! Item was changed: ----- Method: CogMemoryManager32Bits>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- initFreeChunkWithSlots: numSlots at: address self flag: #endianness. self longAt: address put: numSlots; + longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift; - longAt: address + 4 put: self slotSizeMask << self slotSizeHalfShift; longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks" + longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift. - longAt: address + 12 put: self slotSizeMask << self slotSizeHalfShift. ^address + 8! Item was changed: ----- Method: CogMemoryManager32Bits>>objectAfter: (in category 'object enumeration') ----- objectAfter: objOop "Object parsing. 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word + following an object doesn't have a saturated numSlots field it must be a single-header object. + If the word following does have a saturated numSlots it must be the overflow size word." - 2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following - an object doesn't have a saturated size field it must be a single-header object. If the word following - does have a saturated slotSize it must be the overflow size word." | followingWordAddress followingWord | followingWordAddress := self addressAfter: objOop. followingWordAddress >= freeStart ifTrue: [^freeStart]. self flag: #endianness. followingWord := self longAt: followingWordAddress + 4. + ^followingWord >> self numSlotsHalfShift = self numSlotsMask - ^followingWord >> self slotSizeHalfShift = self slotSizeMask ifTrue: [followingWordAddress + self baseHeaderSize] ifFalse: [followingWordAddress]! Item was changed: ----- Method: CogMemoryManager64Bits>>addressAfter: (in category 'object enumeration') ----- addressAfter: objOop "Answer the address immediately following an object." + | numSlots slotBytes | + numSlots := self numSlotsOf: objOop. + slotBytes := numSlots = 0 - | rawSlotSize slotBytes | - rawSlotSize := self baseSlotSizeOf: objOop. - slotBytes := rawSlotSize = 0 ifTrue: [self allocationUnit] + ifFalse: [numSlots << self shiftForWord]. - ifFalse: [rawSlotSize << self shiftForWord]. ^objOop + self baseHeaderSize + slotBytes! Item was changed: ----- Method: CogMemoryManager64Bits>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | numBytes newObj | + "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), + 16 bytes otherwise (num slots in preceeding word). - "Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow), - 16 bytes otherwise (slot size in preceeding word). Objects always have at least one slot, for the forwarding pointer, and are multiples of 8 bytes in length." + numSlots >= self numSlotsMask - numSlots >= self slotSizeMask ifTrue: [numSlots > 16rffffffff ifTrue: [^nil]. newObj := freeStart + self baseHeaderSize. numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" + (numSlots * self bytesPerSlot)] ifFalse: [newObj := freeStart. numBytes := self baseHeaderSize "single header" + (numSlots < 1 ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" ifFalse: [numSlots * self bytesPerSlot])]. freeStart + numBytes > scavengeThreshold ifTrue: [freeStart + numBytes > newSpaceLimit ifTrue: [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]. self scheduleScavenge]. + numSlots >= self numSlotsMask - numSlots >= self slotSizeMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: freeStart put: numSlots. + self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] - self longAt: freeStart + 4 put: self slotSizeMask << self slotSizeHalfShift. - self longLongAt: newObj put: (self headerForSlots: self slotSizeMask format: formatField classIndex: classIndex)] ifFalse: [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. freeStart := freeStart + numBytes. ^newObj! Item was added: + ----- Method: CogMemoryManager64Bits>>bytesInObject: (in category 'object enumeration') ----- + bytesInObject: objOop + "Answer the total number of bytes in an object including header and possible overflow size header." + | halfHeader headerNumSlots numSlots | + self flag: #endianness. + halfHeader := self longAt: objOop + 4. + headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. + numSlots := headerNumSlots = self numSlotsMask + ifTrue: [self longAt: objOop - self baseHeaderSize] + ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]]. + ^numSlots << self shiftForWord + + (headerNumSlots = self numSlotsMask + ifTrue: [self baseHeaderSize + self baseHeaderSize] + ifFalse: [self baseHeaderSize])! Item was changed: ----- Method: CogMemoryManager64Bits>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- initFreeChunkWithSlots: numSlots at: address self flag: #endianness. + self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots; + longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" - self longAt: address put: self slotSizeMask << self slotSizeFullShift + numSlots; - longAt: address + 8 put: self slotSizeMask << self slotSizeFullShift. "0's classIndex; 0 = classIndex of free chunks" ^address + 8! Item was changed: ----- Method: CogMemoryManager64Bits>>objectAfter: (in category 'object enumeration') ----- objectAfter: objOop "Object parsing. 1. all objects have at least a word following the header, for a forwarding pointer. + 2. objects with an overflow size have a preceeing word with a saturated numSlots. If the word + following an object doesn't have a saturated numSlots field it must be a single-header object. + If the word following does have a saturated numSlots it must be the overflow size word." - 2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following - an object doesn't have a saturated size field it must be a single-header object. If the word following - does have a saturated slotSize it must be the overflow size word." | followingWordAddress followingWord | followingWordAddress := self addressAfter: objOop. followingWordAddress >= freeStart ifTrue: [^freeStart]. self flag: #endianness. followingWord := self longAt: followingWordAddress + 4. + ^followingWord >> self numSlotsHalfShift = self numSlotsMask - ^followingWord >> self slotSizeHalfShift = self slotSizeMask ifTrue: [followingWordAddress + self baseHeaderSize] ifFalse: [followingWordAddress]!

1 0

VM Maker: Cog-eem.65.mcz
by commits＠source.squeak.org 03 Sep '13

03 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.65.mcz ==================== Summary ==================== Name: Cog-eem.65 Author: eem Time: 2 September 2013, 4:16:24.009 pm UUID: d29a1aeb-dc42-4821-9ce7-9a100450da2a Ancestors: Cog-eem.64 Change slotsSize to numSlots. =============== Diff against Cog-eem.64 =============== Item was changed: ----- Method: SpurBootstrap>>allocateClassTable (in category 'bootstrap') ----- allocateClassTable "Allocate the root of the classTable plus enough pages to accomodate all classes in the classToIndex map. Don;t fill in the entries yet; the classes have yet to be cloned." | tableRootSize tableRoot page maxSize numPages | tableRootSize := self classTableSize / newHeap classTablePageSize. tableRoot := newHeap allocateSlots: tableRootSize format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. + self assert: (newHeap numSlotsOf: tableRoot) = tableRootSize. - self assert: (newHeap baseSlotSizeOf: tableRoot) = tableRootSize. self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat. self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun. newHeap classTableRootObj: tableRoot. newHeap nilFieldsOf: tableRoot. "first page is strong" page := newHeap allocateSlots: newHeap classTablePageSize format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. + self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize. - self assert: (newHeap baseSlotSizeOf: page) = newHeap classTablePageSize. self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat. self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun. self assert: (newHeap objectAfter: tableRoot) = page. newHeap nilFieldsOf: page. newHeap storePointer: 0 ofObject: tableRoot withValue: page. maxSize := classToIndex inject: 0 into: [:a :b| a max: b]. numPages := (maxSize + newHeap classTableMinorIndexMask / newHeap classTablePageSize) truncated. 2 to: numPages do: [:i| page := newHeap allocateSlots: newHeap classTablePageSize format: newHeap weakArrayFormat classIndex: newHeap weakArrayClassIndexPun. + self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize. - self assert: (newHeap baseSlotSizeOf: page) = newHeap classTablePageSize. self assert: (newHeap formatOf: page) = newHeap weakArrayFormat. self assert: (newHeap classIndexOf: page) = newHeap weakArrayClassIndexPun. newHeap nilFieldsOf: page. newHeap storePointer: i - 1 ofObject: tableRoot withValue: page. self assert: (newHeap objectAfter: (newHeap fetchPointer: i - 2 ofObject: tableRoot)) = page]. pastClassTable := newHeap freeStart.!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev September 2013