[Vm-dev] VM Maker: VMMaker.oscog-eem.410.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Sep 25 07:10:35 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.410.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.410
Author: eem
Time: 25 September 2013, 12:05:46.443 am
UUID: 44528c31-6609-4ea6-8817-4935e5166568
Ancestors: VMMaker.oscog-eem.409
Fix bug in SpurMemMgr>>allocateOldSpaceChunkOfBytes: so it won't
try to create slivers of size 8 byets when splitting free chunks.
Fix nonIndexablePointerFormat to answer the right value.
Explicitly comment the result guaranteed to be young property of
the eeInstantiate* routines.
Implement allocateNewSpaceSlots:format:classIndex: for SpurMemMgr
& implement its eeInstantiate* routines using it.
Adapt createActualMessage: to Spur (fast alloc given class indices).
Eliminate padding from shortPrintOop:
=============== Diff against VMMaker.oscog-eem.409 ===============
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateClassIndex:format:numSlots: (in category 'interpreter access') -----
eeInstantiateClassIndex: compactClassIndex format: objFormat numSlots: numSlots
"Instantiate an instance of a compact class. ee stands for execution engine and
implies that this allocation will *NOT* cause a GC. N.B. the instantiated object
IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
+ call is used in routines that do just that we are safe. Break this rule and die in GC.
+ Result is guaranteed to be young."
- call is used in routines that do just that we are safe. Break this rule and die in GC."
<api>
| hash header1 header2 byteSize header3 hdrSize |
<inline: false>
"cannot have a negative indexable field count"
self assert: (numSlots >= 0 and: [compactClassIndex ~= 0]).
self assert: (objFormat < self firstByteFormat
ifTrue: [objFormat]
ifFalse: [objFormat bitAnd: self byteFormatMask])
= (self instSpecOfClass: (self compactClassAt: compactClassIndex)).
hash := self newObjectHash.
"Low 2 bits are 0"
header1 := (objFormat << self instFormatFieldLSB
bitOr: compactClassIndex << 12)
bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
self assert: "sizeHiBits" ((self formatOfClass: (self compactClassAt: compactClassIndex)) bitAnd: 16r60000) >> 9 = 0.
self flag: #sizeLowBits.
"size in bytes -- low 2 bits are 0; may need another shift if 64-bits.
strangely, size includes size of header, but only of single header.
why include header size at all? gives us an extra word."
byteSize := numSlots << (ShiftForWord + (ShiftForWord-2)) + BaseHeaderSize.
(BytesPerWord = 8 "David, please check this!!!!"
and: [objFormat >= self firstLongFormat "32-bit longs and byte objects"
and: [(numSlots bitAnd: 1) ~= 0]]) ifTrue:
["extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
header1 := header1 bitOr: 4].
byteSize > 255 "requires size header word/full header"
ifTrue: [header3 := byteSize. hdrSize := 3. header2 := self compactClassAt: compactClassIndex]
ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := 1].
^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3!
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateMethodContextSlots: (in category 'interpreter access') -----
eeInstantiateMethodContextSlots: numSlots
"This version of instantiateClass assumes that the total object
size is under 256 bytes, the limit for objects with only one or
two header words. Note that the size is specified in bytes
and should include four bytes for the base header word.
+ Will *not* cause a GC. Result is guaranteed to be young."
- Will *not* cause a GC."
| sizeInBytes hash header1 |
self assert: (numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]).
sizeInBytes := numSlots * BytesPerOop + BaseHeaderSize.
self assert: sizeInBytes <= SizeMask.
hash := self newObjectHash.
header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: self formatOfMethodContextMinusSize.
self assert: (header1 bitAnd: CompactClassMask) > 0. "contexts must be compact"
self assert: (header1 bitAnd: SizeMask) = 0.
"OR size into header1. Must not do this if size > SizeMask"
header1 := header1 + sizeInBytes.
^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: nil h3: nil!
Item was changed:
----- Method: NewObjectMemory>>eeInstantiateSmallClass:numSlots: (in category 'interpreter access') -----
eeInstantiateSmallClass: classPointer numSlots: numSlots
+ "This version of instantiateClass assumes that the total object size is under
+ 256 bytes, the limit for objects with only one or two header words.
- "This version of instantiateClass assumes that the total object
- size is under 256 bytes, the limit for objects with only one or
- two header words.
NOTE this code will only work for sizes that are an integral number of words
+ (hence not a 32-bit LargeInteger in a 64-bit system).
- (like not a 32-bit LargeInteger in a 64-bit system).
- Will *not* cause a GC.
Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak.
+ Since this call is used in routines that do just that we are safe. Break this rule and die in GC.
+ Will *not* cause a GC. Result is guaranteed to be young."
- Since this call is used in routines that do just that we are safe. Break this rule and die."
| sizeInBytes hash header1 header2 hdrSize |
sizeInBytes := numSlots << ShiftForWord + BaseHeaderSize.
self assert: sizeInBytes <= 252.
hash := self newObjectHash.
header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer).
header2 := classPointer.
hdrSize := (header1 bitAnd: CompactClassMask) > 0 "is this a compact class"
ifTrue: [1]
ifFalse: [2].
header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)).
^self eeAllocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0!
Item was changed:
----- Method: Spur32BitMMLESimulator>>scavengingGC (in category 'generation scavenging') -----
scavengingGC
"Run the scavenger."
+ self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
+ ifTrue: ['th']
+ ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
- self halt: (statScavenges + 1) printString, (#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th'), ' scavenge'.
^super scavengingGC!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
+ allocateNewSpaceSlots: 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:
+ [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"
+ freeStart + numBytes > scavengeThreshold ifTrue:
+ [needGCFlag ifFalse: [self scheduleScavenge].
+ freeStart + numBytes > scavenger eden limit ifTrue:
+ [^self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:']].
+ 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: Spur64BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
+ allocateNewSpaceSlots: 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:
+ [needGCFlag ifFalse: [self scheduleScavenge].
+ freeStart + numBytes > scavenger eden limit ifTrue:
+ [^self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:']].
+ 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: SpurMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
+ allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex
+ self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
allocateOldSpaceChunkOfBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if available,
otherwise answer nil. N.B. the chunk is simply a pointer, it has
no valid header. The caller *must* fill in the header correctly."
| initialIndex chunk index nodeBytes parent child smaller larger |
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
initialIndex := chunkBytes / self allocationUnit.
(initialIndex < NumFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
[(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
^self unlinkFreeChunk: chunk atIndex: initialIndex].
freeListsMask := freeListsMask - (1 << initialIndex).
"first search for free chunks of a multiple of chunkBytes in size"
index := initialIndex.
[(index := index + index) < NumFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[((freeListsMask anyMask: 1 << index)
and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk]].
+ "now get desperate and use the first that'll fit.
+ Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
+ leave room for the forwarding pointer/next free link, we can only break chunks
+ that are at least 16 bytes larger, hence start at initialIndex + 2."
+ index := initialIndex + 1.
- "now get desperate and use the first that'll fit"
- index := initialIndex.
[(index := index + 1) < NumFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk].
freeListsMask := freeListsMask - (1 << index)]]].
"Large chunk, or no space on small free lists. Search the large chunk list.
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.
When the search ends parent should hold the smallest chunk at least as
large as chunkBytes, or 0 if none."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[| childBytes |
self assert: (self isFreeObject: child).
childBytes := self bytesInObject: child.
childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
[chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
chunk ~= 0 ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
^self startOfObject: chunk].
child := 0]. "break out of loop to remove interior node"
childBytes < chunkBytes
ifTrue: "walk down the tree"
[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
[parent := child.
nodeBytes := childBytes.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]].
parent = 0 ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
self halt].
"self printFreeChunk: parent"
self assert: nodeBytes >= chunkBytes.
self assert: (self bytesInObject: parent) = nodeBytes.
"attempt to remove from list"
chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: parent.
chunk ~= 0 ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: parent
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk].
"no list; remove an interior node; reorder tree simply. two cases (which have mirrors, for four total):
case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | S |
_/_
| S |
case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | R |
_/_ _\_ _/_
| L | | R | | L |"
chunk := parent.
smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
parent = 0
ifTrue: "no parent; stitch the subnodes back into the root"
[smaller = 0
ifTrue: [freeLists at: 0 put: larger]
ifFalse:
[freeLists at: 0 put: smaller.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]]]
ifFalse: "parent; stitch back into appropriate side of parent."
[smaller = 0
ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: larger]
ifFalse:
[self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: smaller.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]]].
"if there's space left over, add the fragment back."
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk!
Item was changed:
+ ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'allocation') -----
eeInstantiateClassIndex: knownClassIndex format: objFormat numSlots: numSlots
"Instantiate an instance of a compact class. ee stands for execution engine and
implies that this allocation will *NOT* cause a GC. N.B. the instantiated object
IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
+ call is used in routines that do just that we are safe. Break this rule and die in GC.
+ Result is guaranteed to be young."
- call is used in routines that do just that we are safe. Break this rule and die in GC."
<inline: true>
self assert: (numSlots > 0 and: [knownClassIndex ~= 0]).
self assert: (objFormat < self firstByteFormat
ifTrue: [objFormat]
ifFalse: [objFormat bitAnd: self byteFormatMask])
= (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)).
+ ^self allocateNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex!
- ^self allocateSlots: numSlots format: objFormat classIndex: knownClassIndex!
Item was changed:
+ ----- Method: SpurMemoryManager>>eeInstantiateMethodContextSlots: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>eeInstantiateMethodContextSlots: (in category 'allocation') -----
eeInstantiateMethodContextSlots: numSlots
+ "Allocate a new MethodContext. ee stands for execution engine and
+ implies that this allocation will *NOT* cause a GC. N.B. the instantiated object
+ IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
+ call is used in routines that do just that we are safe. Break this rule and die in GC.
+ Result is guaranteed to be young."
<inline: true>
+ <inline: true>
^self
+ allocateNewSpaceSlots: numSlots
- allocateSlots: numSlots
format: self indexablePointersFormat
classIndex: ClassMethodContextCompactIndex!
Item was changed:
+ ----- Method: SpurMemoryManager>>eeInstantiateSmallClass:numSlots: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>eeInstantiateSmallClass:numSlots: (in category 'allocation') -----
eeInstantiateSmallClass: classObj numSlots: numSlots
+ "Instantiate an instance of a class, with only a few slots. ee stands for execution
+ engine and implies that this allocation will *NOT* cause a GC. N.B. the instantiated
+ object IS NOT FILLED and must be completed before returning it to Smalltalk. Since
+ this call is used in routines that do just that we are safe. Break this rule and die in GC.
+ Result is guaranteed to be young."
| classIndex |
<inline: true>
classIndex := self ensureBehaviorHash: classObj.
^self
eeInstantiateClassIndex: classIndex
format: (self instSpecOfClass: classObj)
numSlots: numSlots!
Item was changed:
----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') -----
enterIntoClassTable: aBehavior
"Enter aBehavior into the class table and answer 0. Otherwise answer a primitive failure code."
+ <inline: false>
| initialMajorIndex majorIndex minorIndex page |
majorIndex := classTableIndex >> self classTableMajorIndexShift.
initialMajorIndex := majorIndex.
"classTableIndex should never index the first page; it's reserved for known classes"
self assert: initialMajorIndex > 0.
minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask.
[page := self fetchPointer: majorIndex ofObject: classTableRootObj.
page = nilObj ifTrue:
[page := self allocateSlotsInOldSpace: self classTablePageSize
format: self arrayFormat
classIndex: self arrayClassIndexPun.
page ifNil:
[^PrimErrNoMemory].
self fillObj: page numSlots: self classTablePageSize with: nilObj.
self storePointer: majorIndex
ofObject: classTableRootObj
withValue: page.
minorIndex := 0].
minorIndex to: self classTablePageSize - 1 do:
[:i|
(self fetchPointer: i ofObject: page) = nilObj ifTrue:
[classTableIndex := majorIndex << self classTableMajorIndexShift + i.
self storePointer: i
ofObject: page
withValue: aBehavior.
self setHashBitsOf: aBehavior to: classTableIndex.
self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior.
"now fault-in method lookup chain."
self scanClassPostBecome: aBehavior
effects: BecamePointerObjectFlag+BecameCompiledMethodFlag.
^0]].
majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
[^PrimErrLimitExceeded]] repeat!
Item was changed:
+ ----- Method: SpurMemoryManager>>instantiateClass: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>instantiateClass: (in category 'allocation') -----
instantiateClass: classObj
| instSpec classFormat numSlots classIndex newObj |
classFormat := self formatOfClass: classObj.
instSpec := self instSpecOfClassFormat: classFormat.
(self isFixedSizePointerFormat: instSpec) ifFalse:
[^nil].
classIndex := self ensureBehaviorHash: classObj.
classIndex < 0 ifTrue:
[coInterpreter primitiveFailFor: classIndex negated.
^nil].
numSlots := self fixedFieldsOfClassFormat: classFormat.
newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
newObj ifNotNil:
[self fillObj: newObj numSlots: numSlots with: nilObj].
^newObj!
Item was changed:
+ ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
instantiateClass: classObj indexableSize: nElements
^self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
| sel |
sel := thisContext sender method selector.
(#( DoIt
DoItIn:
on:do: "from the debugger"
makeBaseFrameFor:
quickFetchInteger:ofObject:
frameOfMarriedContext:
objCouldBeClassObj:
isMarriedOrWidowedContext:
shortPrint:
bytecodePrimAt
bytecodePrimAtPut
commonAt:
commonAtPut:
loadFloatOrIntFrom:
positive32BitValueOf:
primitiveExternalCall
checkedIntegerValueOf:
bytecodePrimAtPut
commonAtPut:
primitiveVMParameter
checkIsStillMarriedContext:currentFP:
displayBitsOf:Left:Top:Right:Bottom:
fetchStackPointerOf:
primitiveContextAt
primitiveContextAtPut
subscript:with:storing:format:
printContext:
compare31or32Bits:equal:
signed64BitValueOf:
primDigitMultiply:negative:
digitLength:
isNegativeIntegerValueOf:
magnitude64BitValueOf:
primitiveMakePoint
primitiveAsCharacter
primitiveInputSemaphore
baseFrameReturn
primitiveExternalCall
primDigitCompare:
isLiveContext:
numPointerSlotsOf:
fileValueOf:
loadBitBltDestForm
fetchIntOrFloat:ofObject:ifNil:
fetchIntOrFloat:ofObject:
loadBitBltSourceForm
loadPoint:from:
primDigitAdd:
primDigitSubtract:
positive64BitValueOf:
digitBitLogic:with:opIndex:
signed32BitValueOf:
isNormalized:
+ primDigitDiv:negative:
+ bytesOrInt:growTo:) includes: sel) ifFalse:
- primDigitDiv:negative:) includes: sel) ifFalse:
[self halt].
^(oop bitAnd: 1) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>nonIndexablePointerFormat (in category 'header format') -----
nonIndexablePointerFormat
+ ^1!
- ^2!
Item was changed:
----- Method: StackInterpreter>>createActualMessageTo: (in category 'message sending') -----
createActualMessageTo: lookupClass
"Bundle up the selector, arguments and lookupClass into a Message object.
In the process it pops the arguments off the stack, and pushes the message object.
This can then be presented as the argument of e.g. #doesNotUnderstand:"
| argumentArray message |
<inline: false> "This is a useful break-point"
self assert: ((objectMemory isImmediate: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]).
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [argumentArray := objectMemory
+ eeInstantiateClassIndex: ClassArrayCompactIndex
+ format: objectMemory arrayFormat
+ numSlots: argumentCount.
+ message := objectMemory
+ eeInstantiateClassIndex: ClassMessageCompactIndex
+ format: objectMemory nonIndexablePointerFormat
+ numSlots: MessageLookupClassIndex + 1]
+ ifFalse:
+ [argumentArray := objectMemory
+ eeInstantiateClass: (objectMemory splObj: ClassArray)
+ indexableSize: argumentCount.
+ message := objectMemory
+ eeInstantiateClass: (objectMemory splObj: ClassMessage)
+ indexableSize: 0].
- argumentArray := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount.
- message := objectMemory eeInstantiateClass: (objectMemory splObj: ClassMessage) indexableSize: 0.
"Since the array is new can use unchecked stores."
+ (argumentCount - 1) * BytesPerOop to: 0 by: BytesPerOop negated do:
- (argumentCount - 1) * BytesPerWord to: 0 by: BytesPerWord negated do:
[:i|
self longAt: argumentArray + objectMemory baseHeaderSize + i put: self popStack].
"Since message is new can use unchecked stores."
objectMemory
storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector;
storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray;
storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass.
self push: message.
argumentCount := 1.!
Item was changed:
----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
shortPrintOop: oop
<inline: false>
+ self printHexnp: oop.
- self printHex: oop.
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[^self
cCode: 'printf("=$%ld ($%c)\n", (long)characterValueOf(oop), (long)characterValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
^self
cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
(objectMemory addressCouldBeObj: oop) ifFalse:
[self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']); cr.
^nil].
((objectMemory isFreeObject: oop)
or: [objectMemory isForwarded: oop]) ifTrue:
[^self printOop: oop].
self print: ': a(n) '.
self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5.
self cr!
More information about the Vm-dev
mailing list