[Vm-dev] VM Maker: VMMaker.oscog-eem.343.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Sep 3 01:23:26 UTC 2013
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-big-frame-up. 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]!
More information about the Vm-dev
mailing list