[Vm-dev] VM Maker: VMMaker.oscog-eem.467.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Oct 18 23:47:23 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.467.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.467
Author: eem
Time: 18 October 2013, 4:44:27.269 pm
UUID: e8811a02-2211-46ed-9535-f48c5397ecc0
Ancestors: VMMaker.oscog-eem.466
Rewrite obj stacks to eliminate the awful double indirection so that
both the mark stack and ephemeron queue can be stored in inst vars
of SpurMemMgr.
Simplify markAndTrace: so that it has less duplication and actually
handles large objects correctly.
Remember to mark the freeLists object.
Implement freeing unmarked objs and nilling weak fields post
scan-mark. Implement ephemeron processing.
Add bounds checking to SpurMemMgrSimulator's fetchPointer:
methods.
Replace metaclassSizeBits with metaclassNumSlots and correct
class name printing methods to avoid a bounds violation when applied to e.g. nilObj.
Some isIntegerObject: => isImmediate:'s in CoInterpreter trace
methods.
=============== Diff against VMMaker.oscog-eem.466 ===============
Item was changed:
----- Method: CoInterpreter>>markAndTracePrimTraceLog (in category 'debug support') -----
markAndTracePrimTraceLog
"The prim trace log is a circular buffer of selectors. If there is
an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
If there is something at primTraceLogIndex it has wrapped."
<inline: false>
| limit |
limit := self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize.
(primTraceLog at: limit) = 0 ifTrue: [^nil].
(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
[limit := PrimTraceLogSize - 1].
0 to: limit do:
[:i| | selector |
selector := primTraceLog at: i.
+ (objectMemory isImmediate: selector) ifFalse:
- (objectMemory isIntegerObject: selector) ifFalse:
[objectMemory markAndTrace: selector]]!
Item was changed:
----- Method: CoInterpreter>>markAndTraceStackPage: (in category 'object memory support') -----
markAndTraceStackPage: thePage
| theSP theFP frameRcvrOffset callerFP oop |
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #frameRcvrOffset type: #'char *'>
<var: #callerFP type: #'char *'>
<inline: false>
self assert: (stackPages isFree: thePage) not.
theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage ifFalse:
[theSP := theSP + BytesPerWord].
[frameRcvrOffset := self frameReceiverOffset: theFP.
[theSP <= frameRcvrOffset] whileTrue:
[oop := stackPages longAt: theSP.
+ (objectMemory isImmediate: oop) ifFalse:
- (objectMemory isIntegerObject: oop) ifFalse:
[objectMemory markAndTrace: oop].
theSP := theSP + BytesPerWord].
(self frameHasContext: theFP) ifTrue:
[self assert: (objectMemory isContext: (self frameContext: theFP)).
objectMemory markAndTrace: (self frameContext: theFP)].
(self isMachineCodeFrame: theFP)
ifTrue: [self markAndTraceMachineCodeMethod: (self mframeCogMethod: theFP)]
ifFalse: [objectMemory markAndTrace: (self iframeMethod: theFP)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := theFP + FoxCallerSavedIP + BytesPerWord.
theFP := callerFP].
theSP := theFP + FoxCallerSavedIP + BytesPerWord. "caller ip is ceBaseReturnPC"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
+ (objectMemory isImmediate: oop) ifFalse:
- (objectMemory isIntegerObject: oop) ifFalse:
[objectMemory markAndTrace: oop].
theSP := theSP + BytesPerWord]!
Item was changed:
----- Method: CoInterpreter>>markAndTraceTraceLog (in category 'object memory support') -----
markAndTraceTraceLog
"The trace log is a circular buffer of pairs of entries. If there is an entry at
traceLogIndex - 3 \\ TraceBufferSize it has entries. If there is something at
traceLogIndex it has wrapped."
<inline: false>
| limit |
limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
(traceLog at: limit) = 0 ifTrue: [^nil].
(traceLog at: traceLogIndex) ~= 0 ifTrue:
[limit := TraceBufferSize - 3].
0 to: limit by: 3 do:
[:i| | oop |
oop := traceLog at: i.
+ (objectMemory isImmediate: oop) ifFalse:
- (objectMemory isIntegerObject: oop) ifFalse:
[objectMemory markAndTrace: oop].
oop := traceLog at: i + 1.
+ (objectMemory isImmediate: oop) ifFalse:
- (objectMemory isIntegerObject: oop) ifFalse:
[objectMemory markAndTrace: oop]]!
Item was changed:
----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr
minimumMemory heapSize bytesRead bytesToShift
hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize firstSegSize |
<var: #f type: 'sqImageFile '>
<var: #memStart type: 'usqInt'>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
+ metaclassNumSlots := 6. "guess Metaclass instSize"
- metaclassSizeBits := 6 * BytesPerWord. "guess (Metaclass instSize * BPW)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getLongFromFile: f swap: swapBytes. "N.B. not used."
hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n.
Can be set as a preference (Info.plist, VM.ini, command line etc).
If desiredNumStackPages is already non-zero then it has been
set as a preference. Ignore (but preserve) the header's default."
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
cogCodeSize := desiredCogCodeSize ~= 0
ifTrue: [desiredCogCodeSize]
ifFalse:
[hdrCogCodeSize = 0
ifTrue: [self defaultCogCodeSize]
ifFalse: [hdrCogCodeSize]].
hdrEdenBytes := self getLongFromFile: f swap: swapBytes.
objectMemory edenBytes: (desiredEdenBytes ~= 0
ifTrue: [desiredEdenBytes]
ifFalse:
[hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]]).
desiredEdenBytes := hdrEdenBytes.
hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
hdrMaxExtSemTabSize ~= 0 ifTrue:
[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
"pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
Preserve it to be polite to other VMs."
the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
firstSegSize := self getLongFromFile: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"compare memory requirements with availability"
minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ dataSize
+ objectMemory newSpaceBytes
+ self interpreterAllocationReserveBytes.
heapSize := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ desiredHeapSize
"+ edenBytes" "don't include edenBytes; this is part of the heap and so part of desiredHeapSize"
+ self interpreterAllocationReserveBytes.
heapSize < minimumMemory ifTrue:
[self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
objectMemory memory: (self
allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
headerSize: headerSize) asUnsignedInteger.
objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
heapBase := objectMemory memory + cogCodeSize.
self assert: objectMemory startOfMemory = heapBase.
objectMemory
setHeapBase: heapBase
memoryLimit: objectMemory memory + heapSize - 24 "decrease memoryLimit a tad for safety (?!!?!!? eem eem 10/9/2013 15:15)"
endOfMemory: heapBase + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
self ensureImageFormatIsUpToDate: swapBytes.
"compute difference between old and new memory base addresses"
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
self initializeCodeGenerator.
^dataSize!
Item was changed:
----- Method: CogVMSimulator>>nameOfClass: (in category 'debug support') -----
nameOfClass: classOop
+ | numSlots |
+ classNameIndex ifNil: [^'??nil cnidx??'].
+ numSlots := objectMemory numSlotsOf: classOop.
+ numSlots = metaclassNumSlots ifTrue:
- (objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[^(self nameOfClass:
(objectMemory fetchPointer: thisClassIndex ofObject: classOop)) , ' class'].
+ numSlots <= classNameIndex ifTrue:
+ [^'bad class'].
^self stringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!
Item was changed:
----- Method: CogVMSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[^ '=$' , (objectMemory characterValueOf: oop) printString ,
' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')'].
(objectMemory isIntegerObject: oop) ifTrue:
[^ '=' , (objectMemory integerValueOf: oop) printString ,
' (' , (objectMemory integerValueOf: oop) hex , ')'].
^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']].
(objectMemory isFreeObject: oop) ifTrue:
[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
(objectMemory isForwarded: oop) ifTrue:
[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
classOop := objectMemory fetchClassOfNonImm: oop.
+ (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
- (objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[^'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
[^ '=' , (Character value: (objectMemory integerValueOf:
(objectMemory fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
(#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
[^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: fieldIndex ofObject: objOop
+ self assert: (self isForwarded: objOop) not.
+ self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOf: objOop)]).
+ ^super fetchPointer: fieldIndex ofObject: objOop!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: fieldIndex ofObject: objOop
+ self assert: (self isForwarded: objOop) not.
+ self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)]).
+ ^super fetchPointer: fieldIndex ofObject: objOop!
Item was added:
+ ----- Method: SpurContiguousObjStack>>printOn: (in category 'printing') -----
+ printOn: aStream
+ <doNotGenerate>
+ super printOn: aStream.
+ top ifNotNil:
+ [aStream nextPutAll: ' top: '; nextPutAll: top hex]!
Item was added:
+ ----- Method: SpurGenerationScavenger>>forgetUnmarkedRememberedObjects (in category 'gc - global') -----
+ forgetUnmarkedRememberedObjects
+ "Remove all unmarked objects from the remembered set.
+ This is for global scan-mark GC."
+ | index |
+ index := 0.
+ [index < rememberedSetSize] whileTrue:
+ [| obj |
+ obj := rememberedSet at: index.
+ (manager isMarked: obj)
+ ifTrue: [index := index + 1]
+ ifFalse: "unmarked; remove by overwriting with last element."
+ [manager setIsRememberedOf: obj to: false.
+ rememberedSetSize := rememberedSetSize - 1.
+ rememberedSet at: index put: (rememberedSet at: rememberedSetSize)]].
+ self assert: rememberedSetSize >= 0!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
initialize
"SpurMemoryManager initialize"
BitsPerByte := 8.
"An obj stack is a stack of objects stored in a hidden root slot, such as
the markStack or the ephemeronQueue. It is a linked list of segments,
with the hot end at the head of the list. It is a word object. The stack
pointer is in ObjStackTopx and 0 means empty. The list goes through
ObjStackNextx. We don't want to shrink objStacks, since they're used
in GC and its good to keep their memory around. So unused pages
+ created by popping emptying pages are kept on the ObjStackFreex list.
+ ObjStackNextx must be the last field for swizzleObjStackAt:."
- created by popping emptying pages are kept on the ObjStackFreex list."
ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits"
- ObjStackFixedSlots := 3.
ObjStackTopx := 0.
+ ObjStackMyx := 1.
+ ObjStackFreex := 2.
+ ObjStackNextx := 3.
+ ObjStackFixedSlots := 4.
- ObjStackFreex := 1.
- ObjStackNextx := 2.
ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
"There are currently two obj stacks, the mark stack and the ephemeron queue."
MarkStackRootIndex := self basicNew classTableRootSlots.
EphemeronQueueRootIndex := MarkStackRootIndex + 1.
CheckObjectOverwrite := true.
"The remap buffer support is for compatibility; Spur doesn't GC during allocation.
Eventually this should die."
RemapBufferSize := 25.
"Extra roots are for plugin support."
ExtraRootsSize := 2048 "max. # of external roots"!
Item was changed:
----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') -----
addToFreeList: freeChunk bytes: chunkBytes
| childBytes parent child index |
"coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk."
self assert: (self isFreeObject: freeChunk).
self assert: chunkBytes = (self bytesInObject: freeChunk).
index := chunkBytes / self allocationUnit.
index < self numFreeLists ifTrue:
[self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index).
freeLists at: index put: freeChunk.
freeListsMask := freeListsMask bitOr: 1 << index.
^self].
+
- freeListsMask := freeListsMask bitOr: 1.
self
storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkLargerIndex ofFreeChunk: 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 storePointer: self freeChunkNextIndex
ofFreeChunk: freeChunk
withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
storePointer: self freeChunkNextIndex
ofFreeChunk: 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.
+ freeListsMask := freeListsMask bitOr: 1.
^self].
"insert in tree"
self storePointer: self freeChunkParentIndex
ofFreeChunk: freeChunk
withValue: parent.
self storePointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: freeChunk!
Item was added:
+ ----- Method: SpurMemoryManager>>allUnscannedEphemeronsAreActive (in category 'weakness and ephemerality') -----
+ allUnscannedEphemeronsAreActive
+ unscannedEphemerons start to: unscannedEphemerons top - self wordSize do:
+ [:p| | key |
+ key := self keyOfEphemeron: (self longAt: p).
+ ((self isImmediate: key) or: [self isMarked: key]) ifTrue:
+ [^false]].
+ ^true!
Item was added:
+ ----- Method: SpurMemoryManager>>ensureRoomOnObjStackAt: (in category 'obj stacks') -----
+ ensureRoomOnObjStackAt: objStackRootIndex
+ "An obj stack is a stack of objects stored in a hidden root slot, such as
+ the markStack or the ephemeronQueue. It is a linked list of segments,
+ with the hot end at the head of the list. It is a word object. The stack
+ pointer is in ObjStackTopx and 0 means empty. The list goes through
+ ObjStackNextx. We don't want to shrink objStacks, since they're used
+ in GC and its good to keep their memory around. So unused pages
+ created by popping emptying pages are kept on the ObjStackFreex list."
+ | stackOrNil freeOrNewPage |
+ stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
+ (stackOrNil = nilObj
+ or: [(self fetchPointer: ObjStackTopx ofObject: stackOrNil) >= ObjStackLimit]) ifTrue:
+ [freeOrNewPage := stackOrNil = nilObj
+ ifTrue: [0]
+ ifFalse: [self fetchPointer: ObjStackFreex ofObject: stackOrNil].
+ freeOrNewPage ~= 0
+ ifTrue: "the free page list is always on the new page."
+ [self storePointer: ObjStackFreex ofObjStack: stackOrNil withValue: 0]
+ ifFalse:
+ [freeOrNewPage := self allocateSlotsInOldSpace: ObjStackPageSlots
+ format: self wordIndexableFormat
+ classIndex: self wordSizeClassIndexPun.
+ freeOrNewPage ifNil: [self error: 'no memory to allocate or extend obj stack'].
+ self storePointer: ObjStackFreex ofObjStack: freeOrNewPage withValue: 0].
+ marking ifTrue: [self setIsMarkedOf: freeOrNewPage to: true].
+ self storePointer: ObjStackMyx ofObjStack: freeOrNewPage withValue: objStackRootIndex;
+ storePointer: ObjStackNextx ofObjStack: freeOrNewPage withValue: (stackOrNil = nilObj ifTrue: [0] ifFalse: [stackOrNil]);
+ storePointer: ObjStackTopx ofObjStack: freeOrNewPage withValue: 0;
+ storePointer: objStackRootIndex ofObject: hiddenRootsObj withValue: freeOrNewPage.
+ self assert: (self isValidObjStackAt: objStackRootIndex).
+ "Added a new page; now update and answer the relevant cached first page."
+ ^self updateRootOfObjStack: objStackRootIndex with:freeOrNewPage].
+ self assert: (self isValidObjStackAt: objStackRootIndex).
+ ^stackOrNil!
Item was removed:
- ----- Method: SpurMemoryManager>>ensureRoomOnObjStackAtIndex: (in category 'obj stacks') -----
- ensureRoomOnObjStackAtIndex: objStackRootIndex
- "An obj stack is a stack of objects stored in a hidden root slot, such as
- the markStack or the ephemeronQueue. It is a linked list of segments,
- with the hot end at the head of the list. It is a word object. The stack
- pointer is in ObjStackTopx and 0 means empty. The list goes through
- ObjStackNextx. We don't want to shrink objStacks, since they're used
- in GC and its good to keep their memory around. So unused pages
- created by popping emptying pages are kept on the ObjStackFreex list."
- | stackOrNil freeOrNewPage |
- stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
- (stackOrNil = nilObj
- or: [(self fetchPointer: ObjStackTopx ofObject: stackOrNil) >= ObjStackLimit]) ifTrue:
- [freeOrNewPage := self fetchPointer: ObjStackFreex ofObject: stackOrNil.
- freeOrNewPage ~= 0
- ifTrue: "the free page list is always on the new page."
- [self storePointerUnchecked: ObjStackFreex ofObject: stackOrNil withValue: 0]
- ifFalse:
- [freeOrNewPage := self allocateSlotsInOldSpace: ObjStackPageSlots
- format: self wordIndexableFormat
- classIndex: self wordSizeClassIndexPun.
- freeOrNewPage ifNil: [self error: 'no memory to allocate or extend obj stack'].
- self storePointerUnchecked: ObjStackFreex ofObject: freeOrNewPage withValue: 0].
- marking ifTrue: [self setIsMarkedOf: freeOrNewPage to: true].
- self storePointerUnchecked: ObjStackNextx ofObject: freeOrNewPage withValue: stackOrNil;
- storePointerUnchecked: ObjStackTopx ofObject: freeOrNewPage withValue: 0;
- storePointerUnchecked: objStackRootIndex ofObject: hiddenRootsObj withValue: freeOrNewPage.
- self assert: (self isValidObjStackAt: objStackRootIndex).
- ^freeOrNewPage].
- self assert: (self isValidObjStackAt: objStackRootIndex).
- ^stackOrNil!
Item was changed:
----- Method: SpurMemoryManager>>fetchPointer:ofObject: (in category 'object access') -----
fetchPointer: fieldIndex ofObject: objOop
- self assert: (self isForwarded: objOop) not.
^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!
Item was added:
+ ----- Method: SpurMemoryManager>>fireAllUnscannedEphemerons (in category 'weakness and ephemerality') -----
+ fireAllUnscannedEphemerons
+ self assert: (self noUnscannedEphemerons) not.
+ self assert: self allUnscannedEphemeronsAreActive.
+ unscannedEphemerons start to: unscannedEphemerons top - self wordSize do:
+ [:p|
+ self queueEphemeron: (self longAt: p)].
+ coInterpreter forceInterruptCheck!
Item was added:
+ ----- Method: SpurMemoryManager>>freeListsObj (in category 'free space') -----
+ freeListsObj
+ ^self objectAfter: trueObj!
Item was added:
+ ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndNilUnmarkedWeaklingSlots (in category 'gc - global') -----
+ freeUnmarkedObjectsAndNilUnmarkedWeaklingSlots
+ self checkFreeSpace.
+ scavenger forgetUnmarkedRememberedObjects.
+ self allOldSpaceObjectsDo:
+ [:o|
+ (self isMarked: o)
+ ifTrue:
+ [self setIsMarkedOf: o to: false.
+ ((self isWeakNonImm: o)
+ and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
+ [coInterpreter signalFinalization: o]]
+ ifFalse:
+ [self assert: (self isRemembered: o) not. "scavenger should have clearer this above"
+ self freeObject: o]].
+ self checkFreeSpace!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
self markObjects.
+ self freeUnmarkedObjectsAndNilUnmarkedWeaklingSlots.
- self freeUnmarkedObjects.
self exactFitCompact!
Item was added:
+ ----- Method: SpurMemoryManager>>inactiveOrFailedToDeferScan: (in category 'weakness and ephemerality') -----
+ inactiveOrFailedToDeferScan: anEphemeron
+ "Answer whether an ephemeron is inactive (has a marked key) or,
+ if active, failed to fit on the unscanned ephemerons stack."
+ | key |
+ self assert: (self isEphemeron: anEphemeron).
+ ((self isImmediate: (key := self keyOfEphemeron: anEphemeron))
+ or: [self isMarked: key]) ifTrue:
+ [^true].
+ ^(self pushOnUnscannedEphemeronsStack: anEphemeron) not!
Item was changed:
----- Method: SpurMemoryManager>>initializeMarkStack (in category 'gc - global') -----
initializeMarkStack
+ self ensureRoomOnObjStackAt: MarkStackRootIndex!
- self ensureRoomOnObjStackAtIndex: MarkStackRootIndex!
Item was changed:
----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
initializeObjectMemory: bytesToShift
"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
"Assume: image reader initializes the following variables:
memory
memoryLimit
specialObjectsOop
lastHash
"
<inline: false>
| freeListObj |
"Catch mis-initializations leading to bad translations to C"
self assert: BaseHeaderSize = self baseHeaderSize.
segmentManager adjustSegmentSwizzlesBy: bytesToShift.
"image may be at a different address; adjust oops for new location"
self adjustAllOopsBy: bytesToShift.
segmentManager numSegments > 0 "false if Spur image bootstrap"
ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop]
ifFalse: [self assert: bytesToShift = 0].
"heavily used special objects"
nilObj := self splObj: NilObject.
falseObj := self splObj: FalseObject.
trueObj := self splObj: TrueObject.
"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
conditional branch code as a result). In addition, Spur places the free lists and
class table root page immediately following them."
self assert: nilObj = newSpaceLimit.
self assert: falseObj = (self objectAfter: nilObj).
self assert: trueObj = (self objectAfter: falseObj).
freeListObj := self objectAfter: trueObj.
self reInitializeClassTablePostLoad: (self objectAfter: freeListObj).
self initializeFreeSpacePostLoad: freeListObj.
+ markStack := self swizzleObjStackAt: MarkStackRootIndex.
+ ephemeronQueue := self swizzleObjStackAt: EphemeronQueueRootIndex.
- self swizzleObjStack: MarkStackRootIndex.
- self swizzleObjStack: EphemeronQueueRootIndex.
segmentManager collapseSegmentsPostSwizzle.
self initializeNewSpaceVariables.
self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
"These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi."
growHeadroom := 8*1024*1024. "headroom when growing"
shrinkThreshold := 16*1024*1024. "free space before shrinking"!
Item was added:
+ ----- Method: SpurMemoryManager>>isEmptyObjStack: (in category 'obj stacks') -----
+ isEmptyObjStack: objStack
+ self assert: (self isValidObjStack: objStack).
+ ^0 = (self fetchPointer: ObjStackTopx ofObject: objStack)!
Item was added:
+ ----- Method: SpurMemoryManager>>isValidObjStack: (in category 'obj stacks') -----
+ isValidObjStack: objStack
+ "Answer if the obj stack at objStackRootIndex is valid."
+ ((self addressCouldBeObj: objStack)
+ and: [(self numSlotsOf: objStack) = ObjStackPageSlots]) ifFalse:
+ [objStackInvalidBecause := 'first page not obj or wrong size'.
+ ^false].
+ ^self isValidObjStackPage: objStack
+ myIndex: (self fetchPointer: ObjStackMyx ofObject: objStack)
+ firstPage: true!
Item was changed:
----- Method: SpurMemoryManager>>isValidObjStackAt: (in category 'obj stacks') -----
isValidObjStackAt: objStackRootIndex
"Answer if the obj stack at objStackRootIndex is valid."
| stackOrNil |
stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
^stackOrNil = nilObj
+ or: [self isValidObjStackPage: stackOrNil myIndex: objStackRootIndex firstPage: true]!
- or: [self isValidObjStackPage: stackOrNil firstPage: true]!
Item was removed:
- ----- Method: SpurMemoryManager>>isValidObjStackPage:firstPage: (in category 'obj stacks') -----
- isValidObjStackPage: objStackPage firstPage: isFirstPage
- "Answer if the obj stack at stackRootIndex is valid."
- | freeOrNextPage index |
- <inline: false>
- (self numSlotsOfAny: objStackPage) ~= ObjStackPageSlots ifTrue: [^false].
- freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage.
- freeOrNextPage ~= 0 ifTrue:
- [isFirstPage ifFalse: [^false].
- (self isValidObjStackPage: freeOrNextPage firstPage: false) ifFalse:
- [^false]].
- index := self fetchPointer: ObjStackTopx ofObject: objStackPage.
- (index between: 0 and: ObjStackLimit) ifFalse: [^false].
- freeOrNextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage.
- ^freeOrNextPage = 0
- or: [self isValidObjStackPage: objStackPage firstPage: false]!
Item was added:
+ ----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex:firstPage: (in category 'obj stacks') -----
+ isValidObjStackPage: objStackPage myIndex: myx firstPage: isFirstPage
+ "Answer if the obj stack at stackRootIndex is valid."
+ | freeOrNextPage index |
+ <inline: false>
+ (self numSlotsOfAny: objStackPage) = ObjStackPageSlots ifFalse:
+ [objStackInvalidBecause := 'wong num slots'.
+ ^false].
+ isFirstPage ifTrue:
+ [(myx between: self classTableRootSlots and: self classTableRootSlots + self hiddenRootSlots - 1) ifFalse:
+ [objStackInvalidBecause := 'myx out of range'.
+ ^false].
+ (self fetchPointer: myx ofObject: hiddenRootsObj) = objStackPage ifFalse:
+ [objStackInvalidBecause := 'firstPage is not root'.
+ ^false]].
+ myx = (self fetchPointer: ObjStackMyx ofObject: objStackPage) ifFalse:
+ [objStackInvalidBecause := 'wong myx'.
+ ^false].
+ freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage.
+ freeOrNextPage ~= 0 ifTrue:
+ [isFirstPage ifFalse:
+ [objStackInvalidBecause := 'free page on other than first page'.
+ ^false].
+ (self isValidObjStackPage: freeOrNextPage myIndex: myx firstPage: false) ifFalse:
+ [objStackInvalidBecause := self str: objStackInvalidBecause cat: ' on next page'.
+ ^false]].
+ index := self fetchPointer: ObjStackTopx ofObject: objStackPage.
+ (index between: 0 and: ObjStackLimit) ifFalse:
+ [objStackInvalidBecause := 'bad topx'.
+ ^false].
+ freeOrNextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage.
+ ^freeOrNextPage = 0
+ or: [self isValidObjStackPage: freeOrNextPage myIndex: myx firstPage: false]!
Item was changed:
----- Method: SpurMemoryManager>>markAccessibleObjects (in category 'gc - global') -----
markAccessibleObjects
self assert: self validClassTableRootPages.
marking := true.
+ self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
+ inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord resetTo: 1]].
self markAndTraceObjStack: self markStack andContents: false.
self assert: self validClassTableRootPages.
self markAndTraceObjStack: self ephemeronQueue andContents: true.
self assert: self validClassTableRootPages.
+ self markAndTrace: self freeListsObj.
self markAndTrace: hiddenRootsObj.
self markAndTrace: self specialObjectsOop.
coInterpreter markAndTraceInterpreterOops: true.
self markAndFireEphemerons.
marking := false!
Item was added:
+ ----- Method: SpurMemoryManager>>markAllUnscannedEphemerons (in category 'weakness and ephemerality') -----
+ markAllUnscannedEphemerons
+ "After firing the unscanned ephemerons we must scan-mark them.
+ The wrinkle is that doing so may add more ephemerons to the set."
+ | ptr |
+ self assert: (self noUnscannedEphemerons) not.
+ self assert: self allUnscannedEphemeronsAreActive.
+ ptr := unscannedEphemerons top - self wordSize.
+ [ptr >= unscannedEphemerons start] whileTrue:
+ [| ephemeron key |
+ key := self keyOfEphemeron: (ephemeron := self longAt: ptr).
+ self markAndTrace: key;
+ markAndTrace: ephemeron.
+ unscannedEphemerons top: unscannedEphemerons top - self wordSize.
+ ptr < unscannedEphemerons top ifTrue:
+ ["not the last entry; remove it by overwriting it with the last
+ ephemeron (which must have been newly added by markAndTrace:)."
+ self longAt: ptr put: (self longAt: unscannedEphemerons top)].
+ ptr := ptr - self wordSize]!
Item was added:
+ ----- Method: SpurMemoryManager>>markAndFireEphemerons (in category 'gc - global') -----
+ markAndFireEphemerons
+ <returnTypeC: #void>
+ "After the initial scan-mark is complete ephemerons can be processed."
+ [self noUnscannedEphemerons ifTrue:
+ [^self].
+ self markInactiveEphemerons ifFalse:
+ [self fireAllUnscannedEphemerons].
+ self markAllUnscannedEphemerons]
+ repeat!
Item was changed:
----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') -----
markAndTrace: objOop
+ "Mark the argument, and all objects reachable from it, and any remaining objects on the mark stack.
+ Follow forwarding pointers in the scan."
- "Mark the argument, and all objects reachable from it, and any remaining objects on the mark stack."
<returnTypeC: #void>
+ | objToScan index field |
- | objToScan index key |
self assert: (self isNonImmediate: objOop).
+ "if markAndTrace: is to follow and eliminate forwarding pointers
+ in its scan it cannot be handed an r-value which is forwarded."
+ self assert: (self isForwarded: objOop) not.
(self isMarked: objOop) ifTrue:
+ [^self].
- [^nil].
"self setIsMarkedOf: objOop to: false" "for debugging"
self setIsMarkedOf: objOop to: true.
- ((self isEphemeron: objOop)
- and: [(self isNonImmediate: (key := self keyOfEphemeron: objOop))
- and: [(self isMarked: key) not
- and: [self pushOnUnscannedEphemeronStack: objOop]]]) ifTrue:
- [^self].
"Now scan the object, and any remaining objects on the mark stack."
objToScan := objOop.
+ "To avoid overflowing the mark stack when we encounter large objects, we
+ push the obj, then its numStrongSlots, and then index the object from the stack."
+ [| numStrongSlots |
+ ((self isImmediate: objToScan)
+ or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
+ numStrongSlots > self traceImmediatelySlotLimit])
+ ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any."
+ [(self isImmediate: objToScan)
+ ifTrue:
+ [index := self integerValueOf: objToScan.
+ objToScan := self topOfObjStack: markStack]
- index := 0.
- "It is a bad idea to scan big objects early in the mark phase; pushing all their
- referents onto the mark stack is inviting overflow. Instead, defer until later."
- [| numSlots |
- numSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: nil.
- numSlots > self traceImmediatelySlotLimit ifTrue:
- [(self swapLargeObject: objToScan
- ofSlots: numSlots
- withSmallerOnObjStackAt: MarkStackRootIndex) ifNotNil:
- [:top|
- (self isImmediate: top)
- ifTrue: "index,large object pair"
- [index := self integerValueOf: top.
- objToScan := self popObjStackAt: MarkStackRootIndex]
ifFalse:
+ [index := numStrongSlots].
+ [index > 0] whileTrue:
+ [index := index - 1.
+ field := self fetchPointer: index ofObject: objToScan.
+ (self isOopForwarded: field) ifTrue:
+ [field := self followForwarded: field.
+ self storePointerUnchecked: index ofObject: objToScan withValue: field].
+ ((self isImmediate: field)
+ or: [self isMarked: field]) ifFalse:
+ [self setIsMarkedOf: field to: true.
+ (self topOfObjStack: markStack) ~= objToScan ifTrue:
+ [self push: objToScan onObjStack: markStack].
+ self push: (self integerObjectOf: index) onObjStack: markStack.
+ objToScan := field.
+ index := -1]].
+ index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack."
+ [objToScan := self popObjStack: markStack.
+ objToScan = objOop ifTrue:
+ [objToScan := self popObjStack: markStack]]]
+ ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack."
+ [index := numStrongSlots.
+ [index > 0] whileTrue:
+ [index := index - 1.
+ field := self fetchPointer: index ofObject: objToScan.
+ (self isOopForwarded: field) ifTrue:
+ [field := self followForwarded: field.
+ self storePointerUnchecked: index ofObject: objToScan withValue: field].
+ ((self isImmediate: field)
+ or: [self isMarked: field]) ifFalse:
+ [self setIsMarkedOf: field to: true.
+ self push: field onObjStack: markStack.
+ numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
+ numStrongSlots > self traceImmediatelySlotLimit ifTrue:
+ [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]].
+ objToScan := self popObjStack: markStack].
+ objToScan notNil] whileTrue!
- [objToScan := top]]].
- self assert: (index between: 0 and: (self numStrongSlotsOf: objToScan ephemeronInactiveIf: nil) - 1).
- "The opportunity here is to scan a large object only so far, and push it back on the
- stack when the stack appears full. But for the moment we don't code this; it's tricky."
- [index < numSlots] whileTrue:
- [| field |
- field := self fetchPointer: index ofObject: objToScan.
- ((self isImmediate: field) or: [self isMarked: field]) ifFalse:
- [self setIsMarkedOf: field to: true.
- ((self isEphemeron: field)
- and: [(self isNonImmediate: (key := self keyOfEphemeron: field))
- and: [(self isMarked: key) not
- and: [self pushOnUnscannedEphemeronStack: field]]]) ifFalse:
- [self push: field onObjStackAt: MarkStackRootIndex]].
- index := index + 1].
- objToScan := self popObjStackAt: MarkStackRootIndex.
- objToScan ifNil: [^self].
- (self isImmediate: objToScan)
- ifTrue:
- [index := self integerValueOf: objToScan.
- objToScan := self popObjStackAt: MarkStackRootIndex]
- ifFalse:
- [index := 0]] repeat!
Item was changed:
----- Method: SpurMemoryManager>>markAndTraceObjStack:andContents: (in category 'obj stacks') -----
markAndTraceObjStack: stackOrNil andContents: markAndTraceContents
"An obj stack is a stack of objects stored in a hidden root slot, such
as the markStack or the ephemeronQueue. It is a linked list of
segments, with the hot end at the head of the list. It is a word object.
The stack pointer is in ObjStackTopx and 0 means empty."
<returnTypeC: #void>
| index field |
stackOrNil = nilObj ifTrue:
[^self].
self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
field := self fetchPointer: ObjStackNextx ofObject: stackOrNil.
+ field ~= 0 ifTrue:
+ [self markAndTraceObjStack: field andContents: markAndTraceContents].
- self markAndTraceObjStack: field andContents: markAndTraceContents.
markAndTraceContents ifFalse:
[^self].
+ "There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
+ if there were 6 slots in an oop stack, full would be 2, and the last 0-rel index is 5."
- "There are two fixed slots in an obj stack, and a Topx of 0 indicates empty, so
- if there were 4 slots in an oop stack, full would be 2, and the last 0-rel index is 3.
- Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx"
index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
+ [index >= ObjStackFixedSlots] whileTrue:
- [index > ObjStackNextx] whileTrue:
[field := self fetchPointer: index ofObject: stackOrNil.
(self isImmediate: field) ifFalse:
[self markAndTrace: field].
index := index - 1]!
Item was added:
+ ----- Method: SpurMemoryManager>>markInactiveEphemerons (in category 'weakness and ephemerality') -----
+ markInactiveEphemerons
+ "Go through the unscanned ephemerons, marking the inactive ones, and
+ removing them from the unscanned ephemerons. Answer if any inactive
+ ones were found. We cannot fire the ephemerons until all are found to
+ be active since scan-marking an inactive ephemeron later in the set may
+ render a previously-observed active ephemeron as inactive."
+ | foundInactive ptr |
+ foundInactive := false.
+ ptr := unscannedEphemerons start.
+ [ptr < unscannedEphemerons top] whileTrue:
+ [| ephemeron key |
+ key := self keyOfEphemeron: (ephemeron := self longAt: ptr).
+ ((self isImmediate: key) or: [self isMarked: key])
+ ifTrue:
+ [foundInactive := true.
+ "Now remove the inactive ephemeron from the set, and scan-mark it.
+ Scan-marking it may add more ephemerons to the set."
+ unscannedEphemerons top: unscannedEphemerons top - self wordSize.
+ unscannedEphemerons top > ptr ifTrue:
+ [self longAt: ptr put: (self longAt: unscannedEphemerons top)].
+ self markAndTrace: ephemeron]
+ ifFalse:
+ [ptr := ptr + self wordSize]].
+ ^foundInactive!
Item was added:
+ ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlots: (in category 'weakness and ephemerality') -----
+ nilUnmarkedWeaklingSlots: aWeakling
+ "Nil the unmarked slots in aWeakling and
+ answer if any unmarked slots were found."
+ | anyUnmarked |
+ anyUnmarked := false.
+ (self numStrongSlotsOf: aWeakling ephemeronInactiveIf: nil) to: (self numSlotsOf: aWeakling) - 1 do:
+ [:i| | oop |
+ oop := self fetchPointer: i ofObject: aWeakling.
+ ((self isImmediate: oop) or: [self isMarked: oop]) ifFalse:
+ [self storePointerUnchecked: i ofObject: aWeakling withValue: nilObj.
+ anyUnmarked := true]].
+ ^anyUnmarked!
Item was added:
+ ----- Method: SpurMemoryManager>>noUnscannedEphemerons (in category 'weakness and ephemerality') -----
+ noUnscannedEphemerons
+ ^unscannedEphemerons top = unscannedEphemerons start!
Item was added:
+ ----- Method: SpurMemoryManager>>popObjStack: (in category 'obj stacks') -----
+ popObjStack: objStack
+ | topx top nextPage myx |
+ self assert: (self isValidObjStack: objStack).
+ topx := self fetchPointer: ObjStackTopx ofObject: objStack.
+ topx = 0 ifTrue:
+ [self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0.
+ self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
+ inSmalltalk:
+ [MarkStackRecord ifNotNil:
+ [MarkStackRecord addLast: {#EMPTY. nil}]].
+ ^nil].
+ topx := topx - 1.
+ top := self fetchPointer: topx + ObjStackFixedSlots ofObject: objStack.
+ self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
+ inSmalltalk:
+ [MarkStackRecord ifNotNil:
+ [(MarkStackRecord last first = #push and: [MarkStackRecord last last = top])
+ ifTrue: [MarkStackRecord removeLast]
+ ifFalse: [MarkStackRecord addLast: {#pop. top}]]].
+ self storePointer: ObjStackTopx ofObject: objStack withValue: topx.
+ (topx = 0
+ and: [(nextPage := self fetchPointer: ObjStackNextx ofObject: objStack) ~= 0]) ifTrue:
+ [self storePointer: ObjStackFreex ofObject: nextPage withValue: objStack.
+ myx := self fetchPointer: ObjStackMyx ofObject: objStack.
+ self updateRootOfObjStack: myx with: nextPage].
+ ^top!
Item was removed:
- ----- Method: SpurMemoryManager>>popObjStackAt: (in category 'obj stacks') -----
- popObjStackAt: objStackRootIndex
- self shouldBeImplemented!
Item was added:
+ ----- Method: SpurMemoryManager>>push:onObjStack: (in category 'obj stacks') -----
+ push: objOop onObjStack: objStack
+ | topx |
+ self assert: (self addressCouldBeOop: objOop).
+ self assert: (self isValidObjStack: objStack).
+ (self isImmediate: objOop) ifTrue:
+ [self assert: objStack = markStack.
+ self assert: (self addressCouldBeObj: (self topOfObjStack: objStack))].
+ self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
+ inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord addLast: {#push. objOop}]].
+ topx := self fetchPointer: ObjStackTopx ofObject: objStack.
+ topx >= ObjStackLimit
+ ifTrue:
+ [self push: objOop
+ onObjStack: (self ensureRoomOnObjStackAt: (self fetchPointer: ObjStackMyx ofObject: objStack))]
+ ifFalse:
+ [self storePointer: ObjStackFixedSlots + topx ofObject: objStack withValue: objOop.
+ self storePointer: ObjStackTopx ofObject: objStack withValue: topx + 1].
+ ^objOop!
Item was removed:
- ----- Method: SpurMemoryManager>>push:onObjStackAt: (in category 'obj stacks') -----
- push: objOop onObjStackAt: objStackRootIndex
- | page numEntries |
- page := self ensureRoomOnObjStackAtIndex: objStackRootIndex.
- numEntries := self fetchPointer: ObjStackTopx ofObject: page.
- self assert: numEntries < ObjStackLimit.
- numEntries := numEntries + 1.
- self storePointerUnchecked: numEntries + ObjStackNextx ofObject: page withValue: objOop;
- storePointerUnchecked: ObjStackTopx ofObject: page withValue: numEntries!
Item was removed:
- ----- Method: SpurMemoryManager>>pushOnUnscannedEphemeronStack: (in category 'weakness and ephemerality') -----
- pushOnUnscannedEphemeronStack: anEphemeron
- "Attempt to push anEphemeron on the unscanned ephemerons stack
- and answer if the attempt succeeded. Note that the ephemeron
- stack overflowing isn't a disaster; it simply means treating the
- ephemeron as strong in this GC cycle."
- self assert: (self isEphemeron: anEphemeron).
- unscannedEphemerons top >= unscannedEphemerons limit ifTrue:
- [^false].
- self longAt: unscannedEphemerons top put: anEphemeron.
- unscannedEphemerons top: unscannedEphemerons top + self wordSize.
- ^true!
Item was added:
+ ----- Method: SpurMemoryManager>>pushOnUnscannedEphemeronsStack: (in category 'weakness and ephemerality') -----
+ pushOnUnscannedEphemeronsStack: anEphemeron
+ "Attempt to push anEphemeron on the unscanned ephemerons stack
+ and answer if the attempt succeeded. Note that the ephemeron
+ stack overflowing isn't a disaster; it simply means treating the
+ ephemeron as strong in this GC cycle."
+ <inline: false>
+ self assert: (self isEphemeron: anEphemeron).
+ unscannedEphemerons top >= unscannedEphemerons limit ifTrue:
+ [^false].
+ self longAt: unscannedEphemerons top put: anEphemeron.
+ unscannedEphemerons top: unscannedEphemerons top + self wordSize.
+ ^true!
Item was changed:
----- Method: SpurMemoryManager>>queueEphemeron: (in category 'weakness and ephemerality') -----
queueEphemeron: anEphemeron
self assert: ((self isNonImmediate: anEphemeron)
and: [(self formatOf: anEphemeron) = self ephemeronFormat]).
+ self push: anEphemeron onObjStack: ephemeronQueue!
- self push: anEphemeron onObjStackAt: EphemeronQueueRootIndex!
Item was changed:
----- Method: SpurMemoryManager>>stackValue:ofObjStack: (in category 'obj stacks') -----
stackValue: offset ofObjStack: objStackPage
+ | topx nextPage |
- | numEntries nextPage |
self assert: offset >= 0.
+ topx := self fetchPointer: ObjStackTopx ofObject: objStackPage.
+ offset < topx ifTrue:
- numEntries := self fetchPointer: ObjStackTopx ofObject: objStackPage.
- offset < numEntries ifTrue:
[^self fetchPointer: ObjStackTopx + offset ofObject: objStackPage].
nextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage.
nextPage = 0 ifTrue:
[^nil].
+ ^self stackValue: offset - topx ofObjStack: nextPage!
- ^self stackValue: offset - numEntries ofObjStack: nextPage!
Item was added:
+ ----- Method: SpurMemoryManager>>stackValue:ofObjStack:put: (in category 'obj stacks') -----
+ stackValue: offset ofObjStack: objStackPage put: aValue
+ | topx nextPage |
+ self assert: offset >= 0.
+ topx := self fetchPointer: ObjStackTopx ofObject: objStackPage.
+ offset < topx ifTrue:
+ [^self storePointer: ObjStackTopx + offset ofObjStack: objStackPage withValue: aValue].
+ nextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage.
+ nextPage = 0 ifTrue:
+ [self error: 'no such element on obj stack'].
+ ^self stackValue: offset - topx ofObjStack: nextPage put: aValue!
Item was removed:
- ----- Method: SpurMemoryManager>>stackValue:ofObjStackAt: (in category 'obj stacks') -----
- stackValue: offset ofObjStackAt: objStackRootIndex
- ^self
- stackValue: offset
- ofObjStack: (self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj)!
Item was added:
+ ----- Method: SpurMemoryManager>>storePointer:ofObjStack:withValue: (in category 'object access') -----
+ storePointer: fieldIndex ofObjStack: objOop withValue: valuePointer
+ self assert: (self formatOf: objOop) = self wordIndexableFormat.
+ ^self
+ longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
+ put: valuePointer!
Item was removed:
- ----- Method: SpurMemoryManager>>swapLargeObject:ofSlots:withSmallerOnObjStackAt: (in category 'obj stacks') -----
- swapLargeObject: objOop ofSlots: numStrongSlots withSmallerOnObjStackAt: objStackRootIndex
- "Assuming objOop is large, answer a smaller object, if it is available, otherwise answer nil."
- | objStackPage top topObj |
- objStackPage := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
- top := self stackValue: 0 ofObjStack: objStackPage.
- top ifNil: [^nil].
- (self isImmediate: top) ifTrue: "index,large obj pair on top. is it smaller?"
- [(self integerValueOf: top) >= numStrongSlots ifTrue:
- [^nil]. "no. go with the one we've already got"
- "yes. push 0, objOop, answer index, leaving large obj on top to be popped."
- topObj := self stackValue: 1 ofObjStack: objStackPage.
- self stackValue: 0 ofObjStackAt: objStackRootIndex put: ConstZero.
- self stackValue: 1 ofObjStackAt: objStackRootIndex put: objOop.
- self push: topObj onObjStackAt: objStackRootIndex.
- ^top].
- "push numStrongSlots, objOop and answer top"
- self stackValue: 0 ofObjStackAt: objStackRootIndex put: objOop.
- self push: ConstZero onObjStackAt: objStackRootIndex.
- ^top!
Item was removed:
- ----- Method: SpurMemoryManager>>swizzleObjStack: (in category 'obj stacks') -----
- swizzleObjStack: objStackRootIndex
- <returnTypeC: #void>
- "On load, swizzle the pointers in an obj stack."
- | firstPage stackOrNil index field |
- firstPage := stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
- stackOrNil = nilObj ifTrue:
- [^self].
- [self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
- "There are three fixed slots in an obj stack, and a Topx of 0 indicates empty, so
- if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4.
- Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx"
- index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
- [field := self fetchPointer: index ofObject: stackOrNil.
- (self isImmediate: field) ifFalse:
- [field := segmentManager swizzleObj: field.
- self storePointerUnchecked: ObjStackNextx ofObject: stackOrNil withValue: field].
- (index := index - 1) > ObjStackTopx] whileTrue.
- (stackOrNil := field) ~= 0] whileTrue.
- [stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage.
- stackOrNil ~= 0] whileTrue:
- [field := segmentManager swizzleObj: stackOrNil.
- self storePointerUnchecked: ObjStackFreex ofObject: firstPage withValue: field.
- firstPage := stackOrNil].
- self assert: (self isValidObjStackAt: objStackRootIndex)
- !
Item was added:
+ ----- Method: SpurMemoryManager>>swizzleObjStackAt: (in category 'obj stacks') -----
+ swizzleObjStackAt: objStackRootIndex
+ <returnTypeC: #void>
+ "On load, swizzle the pointers in an obj stack. Answer the obj stack's oop."
+ | firstPage stackOrNil index field |
+ firstPage := stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
+ stackOrNil = nilObj ifTrue:
+ [^stackOrNil].
+ [self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
+ self assert: (self fetchPointer: ObjStackMyx ofObject: stackOrNil) = objStackRootIndex.
+ "There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
+ if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4.
+ Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx"
+ index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
+ "swizzle fields including ObjStackNextx and leave field containing the next link."
+ [field := self fetchPointer: index ofObject: stackOrNil.
+ (self isImmediate: field) ifFalse:
+ [field := segmentManager swizzleObj: field.
+ self storePointer: ObjStackNextx ofObjStack: stackOrNil withValue: field].
+ (index := index - 1) > ObjStackTopx] whileTrue.
+ (stackOrNil := field) ~= 0] whileTrue.
+ [stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage.
+ stackOrNil ~= 0] whileTrue:
+ [field := segmentManager swizzleObj: stackOrNil.
+ self storePointer: ObjStackFreex ofObjStack: firstPage withValue: field.
+ firstPage := stackOrNil].
+ self assert: (self isValidObjStackAt: objStackRootIndex)
+ !
Item was added:
+ ----- Method: SpurMemoryManager>>topOfObjStack: (in category 'obj stacks') -----
+ topOfObjStack: objStack
+ | topx |
+ self assert: (self isValidObjStack: objStack).
+ topx := self fetchPointer: ObjStackTopx ofObject: objStack.
+ topx = 0 ifTrue:
+ [self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0.
+ ^nil].
+ ^self fetchPointer: topx + ObjStackFixedSlots - 1 ofObject: objStack!
Item was added:
+ ----- Method: SpurMemoryManager>>updateRootOfObjStack:with: (in category 'obj stacks') -----
+ updateRootOfObjStack: objStackRootIndex with: newRootPage
+ self assert: (self isValidObjStack: newRootPage).
+ objStackRootIndex caseOf: {
+ [MarkStackRootIndex] -> [markStack := newRootPage].
+ [EphemeronQueueRootIndex] -> [ephemeronQueue := newRootPage] }.
+ ^newRootPage!
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 lkupClassTag lkupClass methodDictLinearSearchLimit 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 metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
- instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit 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 the2ndUnknownShort 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 VMSpurObjectRepresentationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
category: 'VMMaker-Interpreter'!
!StackInterpreter commentStamp: 'eem 9/11/2013 18:30' 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. An even better solution is to eliminate compact classes altogether (see 6.).
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. [Late news, the support has been extended to 64-bit file 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. We can still have 31-bit SmallIntegers by allowing two tag patterns for SmallInteger.
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. [Late breaking news, the 2-word header scheme is more compact, by over 2%]. See SpurMemorymanager's class comment.!
Item was changed:
----- Method: StackInterpreter>>initializeExtraClassInstVarIndices (in category 'initialization') -----
initializeExtraClassInstVarIndices
+ "Initialize metaclassNumSlots and thisClassIndex which are used in debug printing, and
- "Initialize metaclassSizeBits and thisClassIndex which are used in debug printing, and
classNameIndex which is used not only for debug printing but for is:KindOf: & is:MemberOf:
via classNameOf:is: (evil but a reality we have to accept)."
| classArrayObj classArrayClass |
classArrayObj := objectMemory splObj: ClassArray.
classArrayClass := objectMemory fetchClassOfNonImm: classArrayObj.
+ metaclassNumSlots := objectMemory numSlotsOf: classArrayClass. "determine actual Metaclass instSize"
- metaclassSizeBits := objectMemory sizeBitsOf: classArrayClass. "determine actual (Metaclass instSize * 4)"
thisClassIndex := 5. "default"
InstanceSpecificationIndex + 1 to: (objectMemory lengthOf: classArrayClass) do:
[:i|
(objectMemory fetchPointer: i - 1 ofObject: classArrayClass) = classArrayObj ifTrue:
[thisClassIndex := i - 1]].
classNameIndex := 6. "default"
InstanceSpecificationIndex + 1 to: (objectMemory lengthOf: classArrayObj) do:
[:i| | oop |
oop := objectMemory fetchPointer: i - 1 ofObject: classArrayObj.
((objectMemory isBytes: oop)
and: [(objectMemory lengthOf: oop) = 5
and: [(self str: 'Array' n: (objectMemory firstFixedField: oop) cmp: 5) = 0]]) ifTrue:
[classNameIndex := i - 1]]!
Item was changed:
----- Method: StackInterpreter>>lengthOfNameOfClass: (in category 'debug printing') -----
lengthOfNameOfClass: classOop
<inline: false>
+ | numSlots |
+ numSlots := objectMemory numSlotsOf: classOop.
+ numSlots = metaclassNumSlots ifTrue:
- (objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[^self lengthOfNameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop)].
+ numSlots <= classNameIndex ifTrue:
+ [^0].
^objectMemory lengthOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!
Item was changed:
----- Method: StackInterpreter>>nameOfClass: (in category 'debug printing') -----
nameOfClass: classOop
"Brain-damaged nameOfClass: for C VM. Does *not* answer Foo class for metaclasses.
Use e.g. classIsMeta: to avoid being fooled."
<inline: false>
<returnTypeC: 'char *'>
+ | numSlots |
+ numSlots := objectMemory numSlotsOf: classOop.
+ numSlots = metaclassNumSlots ifTrue:
- (objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[^self nameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop)].
+ numSlots <= classNameIndex ifTrue:
+ [^'bad class'].
^objectMemory firstFixedField: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!
Item was changed:
----- Method: StackInterpreter>>printNameOfClass:count: (in category 'debug printing') -----
printNameOfClass: classOop count: cnt
"Details: The count argument is used to avoid a possible infinite recursion if classOop is a corrupted object."
<inline: false>
+ | numSlots |
classNameIndex ifNil:
[self print: '??nil cnidx??'.
^self].
(classOop isNil or: [classOop = 0 or: [cnt <= 0]]) ifTrue: [^self print: 'bad class'].
+ numSlots := objectMemory numSlotsOf: classOop.
+ (numSlots = metaclassNumSlots
+ and: [metaclassNumSlots > thisClassIndex])
- ((objectMemory sizeBitsOf: classOop) = metaclassSizeBits
- and: [metaclassSizeBits > (thisClassIndex * BytesPerOop)]) "(Metaclass instSize * 4)"
ifTrue: [self printNameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop) count: cnt - 1.
self print: ' class']
+ ifFalse:
+ [numSlots <= classNameIndex
+ ifTrue: [self print: 'bad class']
+ ifFalse:
+ [self printStringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)]]!
- ifFalse: [self printStringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)]!
Item was changed:
----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
printOopShortInner: oop
| classOop name nameLen |
<var: #name type: #'char *'>
<inline: true>
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[self printChar: $$;
printChar: (objectMemory characterValueOf: oop);
printChar: $(;
printHex: (objectMemory integerValueOf: oop);
printChar: $).
^nil].
self printNum: (objectMemory integerValueOf: oop);
printChar: $(;
printHex: (objectMemory integerValueOf: oop);
printChar: $).
^nil].
(objectMemory addressCouldBeObj: oop) ifFalse:
[self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']); cr.
^nil].
(self isFloatObject: oop) ifTrue:
[self printFloat: (self dbgFloatValueOf: oop).
^nil].
classOop := objectMemory fetchClassOfNonImm: oop.
(objectMemory addressCouldBeObj: classOop) ifFalse:
[self print: 'a ??'. ^nil].
+ (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
- (objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[self printNameOfClass: oop count: 5.
^nil].
oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
nameLen := self lengthOfNameOfClass: classOop.
nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
name := self nameOfClass: classOop.
nameLen = 10 ifTrue:
[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
[self printChar: $'; printStringOf: oop; printChar: $'.
^nil].
(self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
[self printChar: $#; printStringOf: oop.
^nil]].
(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
^nil].
self print: 'a(n) '.
1 to: nameLen do: [:i| self printChar: (name at: i)].
"Try to spot association-like things; they're all subclasses of LookupKey"
((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
and: [(self superclassOf: classOop) = (self superclassOf: (objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation)))
and: [objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue:
[self space;
printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
print: ' -> ';
printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]!
Item was changed:
----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages
minimumMemory heapBase bytesRead bytesToShift heapSize hdrEdenBytes
headerFlags hdrMaxExtSemTabSize firstSegSize |
<var: #f type: 'sqImageFile '>
<var: #heapBase type: 'usqInt'>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
+ metaclassNumSlots := 6. "guess Metaclass instSize"
- metaclassSizeBits := 6 * BytesPerWord. "guess (Metaclass instSize * BPW)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getLongFromFile: f swap: swapBytes.
hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n.
Can be set as a preference (Info.plist, VM.ini, command line etc).
If desiredNumStackPages is already non-zero then it has been
set as a preference. Ignore (but preserve) the header's default."
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
"pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
It is used for the cog code size in Cog. Preserve it to be polite to other VMs."
theUnknownShort := self getShortFromFile: f swap: swapBytes.
hdrEdenBytes := self getLongFromFile: f swap: swapBytes.
objectMemory edenBytes: (desiredEdenBytes ~= 0
ifTrue: [desiredEdenBytes]
ifFalse:
[hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]]).
desiredEdenBytes := hdrEdenBytes.
hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
hdrMaxExtSemTabSize ~= 0 ifTrue:
[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
"pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
Preserve it to be polite to other VMs."
the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
firstSegSize := self getLongFromFile: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"decrease Squeak object heap to leave extra memory for the VM"
heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
"compare memory requirements with availability".
minimumMemory := dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes.
heapSize < minimumMemory ifTrue:
[self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap"
objectMemory memory: (self
allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
headerSize: headerSize) asUnsignedInteger.
objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
heapBase := objectMemory startOfMemory.
objectMemory
setHeapBase: heapBase
memoryLimit: (heapBase + heapSize) - 24 "decrease memoryLimit a tad for safety"
endOfMemory: heapBase + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
self ensureImageFormatIsUpToDate: swapBytes.
"compute difference between old and new memory base addresses"
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
^dataSize!
Item was changed:
----- Method: StackInterpreterSimulator>>nameOfClass: (in category 'debug support') -----
nameOfClass: classOop
+ | numSlots |
classNameIndex ifNil: [^'??nil cnidx??'].
+ numSlots := objectMemory numSlotsOf: classOop.
+ numSlots = metaclassNumSlots ifTrue:
- (objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[^(self nameOfClass:
(objectMemory fetchPointer: thisClassIndex ofObject: classOop)) , ' class'].
+ numSlots <= classNameIndex ifTrue:
+ [^'bad class'].
^self stringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!
Item was changed:
----- Method: StackInterpreterSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[^ '=$' , (objectMemory characterValueOf: oop) printString ,
' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')'].
(objectMemory isIntegerObject: oop) ifTrue:
[^ '=' , (objectMemory integerValueOf: oop) printString ,
' (' , (objectMemory integerValueOf: oop) hex , ')'].
^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']].
(objectMemory isFreeObject: oop) ifTrue:
[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
(objectMemory isForwarded: oop) ifTrue:
[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
classOop := objectMemory fetchClassOfNonImm: oop.
+ (objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
- (objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[^'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
[^ '=' , (Character value: (objectMemory integerValueOf:
(objectMemory fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
(#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
[^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!
More information about the Vm-dev
mailing list