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