[Vm-dev] VM Maker: VMMaker.oscog-eem.816.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Jul 11 17:00:44 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.816.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.816
Author: eem
Time: 11 July 2014, 9:57:59.625 am
UUID: 33bf745c-6348-4ad4-9ad3-bec0373bacd4
Ancestors: VMMaker.oscog-eem.815
Spur:
Fix bugs in clone:; allocateSlots:... may fail and cloning
compiled methods still needs a store check.
Fix become performance issue of following possibly
becommed selectors by adding a read barrier to
lookupMethodInDictionary: et al. This is much cheaper than
following all dictionaries in the classTable post become.
Control the policy switch with a class var in the hope that
an efficient eager solution can be found.
Add stats that count the causes of followForwardedObject-
Fields:toDepth: (used to track down the above issue).
Make optional via a class var. Move stringForCString: from
StackInterpreter to the object memories.
Reposition ensureNoForwardedLiteralsIn: and replace
cePositive32BitIntegerFor: with positive32BitIntegerFor:.
Remove the assert check in isForwarded: to make sure it is
inined. Mkae sure possibleRootStoreInto: is not inlined.
StackInterpreter:
Extract the vars initialized to zero or false to an initialize
method from initializeInterpreter:.
Slang:
Fix option processing so that interpreterClass and
objectMemoryClass class vars can be tested (for the
above class vars).
=============== Diff against VMMaker.oscog-eem.815 ===============
Item was changed:
----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
shouldIncludeMethodFor: aClass selector: selector
"Answer whether a method shoud be translated. Process optional methods by
interpreting the argument to the option: pragma as either a Cogit class name
or a class variable name or a variable name in VMBasicConstants. Exclude
methods with the doNotGenerate pragma."
| pragmas |
(pragmas := (aClass >> selector) pragmas select: [:p| p keyword == #option:]) notEmpty ifTrue:
[pragmas do:
[:pragma| | key |
key := pragma argumentAt: 1.
vmMaker ifNotNil:
[vmMaker cogitClassName ifNotNil:
[(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue:
[| cogitClass optionClass |
cogitClass := Smalltalk classNamed: vmMaker cogitClassName.
optionClass := Smalltalk classNamed: key.
^cogitClass includesBehavior: optionClass]].
((vmClass
ifNotNil: [vmClass initializationOptions]
ifNil: [vmMaker options]) at: key ifAbsent: [false]) ifNotNil:
+ [:option| option ~~ false ifTrue: [^true]]].
+ "Lookup options in class variables of the defining class, VMMaker, the interpreterClass and the objectMemoryClass"
+ ((vmMaker notNil and: [vmMaker interpreterClass notNil])
+ ifTrue: [{aClass. VMBasicConstants. vmMaker interpreterClass. vmMaker interpreterClass objectMemoryClass}]
+ ifFalse: [{aClass. VMBasicConstants}]) do:
+ [:scope|
+ (scope bindingOf: key) ifNotNil:
+ [:binding|
+ binding value ~~ false ifTrue: [^true]]]].
- [:option| option ~~ false ifTrue: [^true]].
- (aClass bindingOf: key) ifNotNil:
- [:binding|
- binding value ~~ false ifTrue: [^true]].
- (VMBasicConstants bindingOf: key) ifNotNil:
- [:binding|
- binding value ~~ false ifTrue: [^true]]]].
^false].
^(aClass >> selector pragmaAt: #doNotGenerate) isNil!
Item was removed:
- ----- Method: CoInterpreter>>cePositive32BitIntegerFor: (in category 'trampolines') -----
- cePositive32BitIntegerFor: anInteger
- <api>
- <var: #anInteger type: #usqInt>
- ^self positive32BitIntegerFor: anInteger!
Item was changed:
----- Method: CoInterpreter>>followForwardedFieldsInCurrentMethod (in category 'message sending') -----
followForwardedFieldsInCurrentMethod
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
<inline: false>
+ objectMemory forwardingCount: [statFollowCurrentMethod := statFollowCurrentMethod + 1].
(self isMachineCodeFrame: framePointer)
ifTrue:
[cogMethod := self mframeHomeMethod: framePointer.
objectMemory
followForwardedObjectFields: cogMethod methodObject
toDepth: 0.
cogit followForwardedLiteralsIn: cogMethod]
ifFalse:
[objectMemory
followForwardedObjectFields: method
toDepth: 0]!
Item was changed:
----- Method: CoInterpreter>>handleForwardedSendFaultForReceiver:stackDelta: (in category 'message sending') -----
handleForwardedSendFaultForReceiver: forwardedReceiver stackDelta: stackDelta
"Handle a send fault that may be due to a send to a forwarded object.
Unforward the receiver on the stack and answer it."
<option: #SpurObjectMemory>
| rcvrStackIndex rcvr |
<inline: false>
"should *not* be a super send, so the receiver should be forwarded."
self assert: (objectMemory isOopForwarded: forwardedReceiver).
rcvrStackIndex := argumentCount + stackDelta.
self assert: (self stackValue: rcvrStackIndex) = forwardedReceiver.
rcvr := objectMemory followForwarded: forwardedReceiver.
self stackValue: rcvrStackIndex put: rcvr.
self followForwardedFrameContents: framePointer
stackPointer: stackPointer + (rcvrStackIndex + 1 * BytesPerWord). "don't repeat effort"
(objectMemory isPointers: (self frameReceiver: framePointer)) ifTrue:
+ [objectMemory forwardingCount: [statFollowForSendFault := statFollowForSendFault + 1].
+ objectMemory
- [objectMemory
followForwardedObjectFields: (self frameReceiver: framePointer)
toDepth: 0].
self followForwardedFieldsInCurrentMethod.
^rcvr!
Item was added:
+ ----- Method: CoInterpreter>>positive32BitIntegerFor: (in category 'trampolines') -----
+ positive32BitIntegerFor: integerValue
+ <api>
+ ^super positive32BitIntegerFor: integerValue!
Item was changed:
----- Method: CoInterpreter>>synchronousSignal: (in category 'process primitive support') -----
synchronousSignal: aSemaphore
"Signal the given semaphore from within the interpreter.
Answer if the current process was preempted.
Override to add tracing info."
| excessSignals |
<inline: false>
(self isEmptyList: aSemaphore) ifTrue:
["no process is waiting on this semaphore"
excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: aSemaphore.
self storeInteger: ExcessSignalsIndex
ofObject: aSemaphore
withValue: excessSignals + 1.
^false].
objectMemory hasSpurMemoryManagerAPI ifTrue:
[| firstLink |
firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aSemaphore.
(objectMemory isForwarded: firstLink) ifTrue:
["0 = aSemaphore, 1 = aProcess. Hence reference to suspendedContext will /not/ be forwarded."
+ objectMemory forwardingCount: [statFollowForSignal := statFollowForSignal + 1].
objectMemory followForwardedObjectFields: aSemaphore toDepth: 1].
self assert: (objectMemory isForwarded: (objectMemory fetchPointer: SuspendedContextIndex ofObject: firstLink)) not].
^self resume: (self removeFirstLinkOfList: aSemaphore)
preemptedYieldingIf: preemptionYields
from: CSSignal!
Item was changed:
----- Method: CogObjectRepresentationForSpur>>ensureNoForwardedLiteralsIn: (in category 'initialization') -----
ensureNoForwardedLiteralsIn: aMethodObj
"Ensure there are no forwarded literals in the argument."
+ <doNotGenerate>
+ objectMemory ensureNoForwardedLiteralsIn: aMethodObj!
- <inline: true>
- objectMemory
- followForwardedObjectFields: aMethodObj
- toDepth: 0!
Item was changed:
----- Method: CogObjectRepresentationForSqueakV3>>generateObjectRepresentationTrampolines (in category 'initialization') -----
generateObjectRepresentationTrampolines
super generateObjectRepresentationTrampolines.
ceCreateNewArrayTrampoline := cogit genTrampolineFor: #ceNewArraySlotSize:
called: 'ceCreateNewArrayTrampoline'
arg: SendNumArgsReg
result: ReceiverResultReg.
+ cePositive32BitIntegerTrampoline := cogit genTrampolineFor: #positive32BitIntegerFor:
- cePositive32BitIntegerTrampoline := cogit genTrampolineFor: #cePositive32BitIntegerFor:
called: 'cePositive32BitIntegerTrampoline'
arg: ReceiverResultReg
result: TempReg.
ceActiveContextTrampoline := self genActiveContextTrampoline.
ceClosureCopyTrampoline := cogit genTrampolineFor: #ceClosureCopyDescriptor:
called: 'ceClosureCopyTrampoline'
arg: SendNumArgsReg
result: ReceiverResultReg!
Item was changed:
----- Method: Cogit>>cog:selector: (in category 'jit - api') -----
cog: aMethodObj selector: aSelectorOop
"Attempt to produce a machine code method for the bytecode method
object aMethodObj. N.B. If there is no code memory available do *NOT*
attempt to reclaim the method zone. Certain clients (e.g. ceSICMiss:)
depend on the zone remaining constant across method generation."
<api>
<returnTypeC: #'CogMethod *'>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
self assert: ((coInterpreter methodHasCogMethod: aMethodObj) not
or: [(self noAssertMethodClassAssociationOf: aMethodObj) = objectMemory nilObject]).
"coInterpreter stringOf: aSelectorOop"
coInterpreter
compilationBreak: aSelectorOop
point: (objectMemory lengthOf: aSelectorOop).
aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
self cppIf: NewspeakVM
ifTrue: [cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop.
cogMethod ifNotNil:
[(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue:
[self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader.
cogMethod methodObject: aMethodObj.
coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger].
^cogMethod]].
"If the generators for the alternate bytecode set are missing then interpret."
(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
ifTrue:
[(self numElementsIn: generatorTable) <= 256 ifTrue:
[^nil].
bytecodeSetOffset := 256]
ifFalse:
[bytecodeSetOffset := 0].
extA := extB := 0.
+ objectMemory ensureNoForwardedLiteralsIn: aMethodObj.
- objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
methodObj := aMethodObj.
cogMethod := self compileCogMethod: aSelectorOop.
(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
[cogMethod asInteger = InsufficientCodeSpace ifTrue:
[coInterpreter callForCogCompiledCodeCompaction].
self maybeFreeCounters.
"Right now no errors should be reported, so nothing more to do."
"self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
^nil].
"self cCode: ''
inSmalltalk:
[coInterpreter printCogMethod: cogMethod.
""coInterpreter symbolicMethod: aMethodObj.""
self assertValidMethodMap: cogMethod."
"self disassembleMethod: cogMethod."
"printInstructions := clickConfirm := true""]."
^cogMethod!
Item was changed:
----- Method: Cogit>>cogCodeConstituents (in category 'profiling primitives') -----
cogCodeConstituents
"Answer the contents of the code zone as an array of pair-wise element, address in ascending address order.
Answer a string for a runtime routine or abstract label (beginning, end, etc), a CompiledMethod for a CMMethod,
or a selector (presumably a Symbol) for a PIC."
<api>
| count cogMethod constituents label value |
<var: #cogMethod type: #'CogMethod *'>
count := trampolineTableIndex / 2 + 3. "+ 3 for start, freeStart and end"
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[count := count + 1].
cogMethod := methodZone methodAfter: cogMethod].
constituents := coInterpreter instantiateClass: coInterpreter classArray indexableSize: count * 2.
constituents isNil ifTrue:
[^constituents].
coInterpreter pushRemappableOop: constituents.
+ ((label := objectMemory stringForCString: 'CogCode') isNil
+ or: [(value := coInterpreter positive32BitIntegerFor: codeBase) isNil]) ifTrue:
- ((label := coInterpreter stringForCString: 'CogCode') isNil
- or: [(value := coInterpreter cePositive32BitIntegerFor: codeBase) isNil]) ifTrue:
[^nil].
coInterpreter
storePointerUnchecked: 0 ofObject: coInterpreter topRemappableOop withValue: label;
storePointerUnchecked: 1 ofObject: coInterpreter topRemappableOop withValue: value.
0 to: trampolineTableIndex - 1 by: 2 do:
[:i|
+ ((label := objectMemory stringForCString: (trampolineAddresses at: i)) isNil
+ or: [(value := coInterpreter positive32BitIntegerFor: (trampolineAddresses at: i + 1) asUnsignedInteger) isNil]) ifTrue:
- ((label := coInterpreter stringForCString: (trampolineAddresses at: i)) isNil
- or: [(value := coInterpreter cePositive32BitIntegerFor: (trampolineAddresses at: i + 1) asUnsignedInteger) isNil]) ifTrue:
[coInterpreter popRemappableOop.
^nil].
coInterpreter
storePointerUnchecked: 2 + i ofObject: coInterpreter topRemappableOop withValue: label;
storePointerUnchecked: 3 + i ofObject: coInterpreter topRemappableOop withValue: value].
count := trampolineTableIndex + 2.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[coInterpreter
storePointerUnchecked: count
ofObject: coInterpreter topRemappableOop
withValue: (cogMethod cmType = CMMethod
ifTrue: [cogMethod methodObject]
ifFalse: [cogMethod selector]).
+ (value := coInterpreter positive32BitIntegerFor: cogMethod asUnsignedInteger) isNil ifTrue:
- (value := coInterpreter cePositive32BitIntegerFor: cogMethod asUnsignedInteger) isNil ifTrue:
[coInterpreter popRemappableOop.
^nil].
coInterpreter
storePointerUnchecked: count + 1
ofObject: coInterpreter topRemappableOop
withValue: value.
count := count + 2].
cogMethod := methodZone methodAfter: cogMethod].
+ ((label := objectMemory stringForCString: 'CCFree') isNil
+ or: [(value := coInterpreter positive32BitIntegerFor: methodZone freeStart) isNil]) ifTrue:
- ((label := coInterpreter stringForCString: 'CCFree') isNil
- or: [(value := coInterpreter cePositive32BitIntegerFor: methodZone freeStart) isNil]) ifTrue:
[coInterpreter popRemappableOop.
^nil].
coInterpreter
storePointerUnchecked: count ofObject: coInterpreter topRemappableOop withValue: label;
storePointerUnchecked: count + 1 ofObject: coInterpreter topRemappableOop withValue: value.
+ ((label := objectMemory stringForCString: 'CCEnd') isNil
+ or: [(value := coInterpreter positive32BitIntegerFor: methodZone zoneEnd) isNil]) ifTrue:
- ((label := coInterpreter stringForCString: 'CCEnd') isNil
- or: [(value := coInterpreter cePositive32BitIntegerFor: methodZone zoneEnd) isNil]) ifTrue:
[coInterpreter popRemappableOop.
^nil].
coInterpreter
storePointerUnchecked: count + 2 ofObject: coInterpreter topRemappableOop withValue: label;
storePointerUnchecked: count + 3 ofObject: coInterpreter topRemappableOop withValue: value.
constituents := coInterpreter popRemappableOop.
coInterpreter beRootIfOld: constituents.
^constituents!
Item was changed:
----- Method: Cogit>>implicitReceiverCacheAddressAt: (in category 'newspeak support') -----
implicitReceiverCacheAddressAt: mcpc
"Cached push implicit receiver implementation. If objectRepresentation doesn't support
pinning then caller looks like
mov selector, SendNumArgsReg
call ceImplicitReceiver
br continue
Lclass: .word
Lmixin:: .word
continue:
If objectRepresentation supports pinning then caller looks like
mov Lclass, Arg1Reg
mov selector, SendNumArgsReg
call ceImplicitReceiver
and Lclass: .word; Lmixin: .word is somewhere on the heap."
+ <option: #NewspeakVM>
<inline: true>
^objectRepresentation canPinObjects
ifTrue:
[backEnd implicitReceiveCacheAt: mcpc]
ifFalse:
[mcpc asUnsignedInteger + backEnd jumpShortByteSize]!
Item was changed:
----- Method: Cogit>>voidImplicitReceiverCacheAt: (in category 'newspeak support') -----
voidImplicitReceiverCacheAt: mcpc
"Cached push implicit receiver implementation. If objectRepresentation doesn't support
pinning then caller looks like
mov selector, SendNumArgsReg
call ceImplicitReceiver
br continue
Lclass: .word
Lmixin:: .word
continue:
If objectRepresentation supports pinning then caller looks like
mov Lclass, Arg1Reg
mov selector, SendNumArgsReg
call ceImplicitReceiver
and Lclass: .word; Lmixin: .word is somewhere on the heap."
+ <option: #NewspeakVM>
-
| cacheAddress |
self assert: NumOopsPerIRC = 2.
cacheAddress := self implicitReceiverCacheAddressAt: mcpc.
backEnd
unalignedLongAt: cacheAddress put: 0;
unalignedLongAt: cacheAddress + BytesPerOop put: 0!
Item was changed:
----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
+ followForwardedObjectFields: objOop toDepth: depth
- followForwardedObjectFields: methodObh toDepth: depth
"This is a noop in the facade"!
Item was added:
+ ----- Method: ObjectMemory>>followMaybeForwardedSelector: (in category 'interpreter access') -----
+ followMaybeForwardedSelector: oop
+ "Spur compatibility; in V3 this is just a noop"
+ <inline: true>
+ ^oop!
Item was added:
+ ----- Method: ObjectMemory>>followMaybeForwardedSelector:into: (in category 'interpreter access') -----
+ followMaybeForwardedSelector: oop into: aBlock
+ "Spur compatibility; in V3 this is just a noop"
+ <inline: true>!
Item was added:
+ ----- Method: ObjectMemory>>forwardingCount: (in category 'spur compatibility') -----
+ forwardingCount: aBlock
+ "Hook for turning on and off statistics gathering on forwarding. Off here-in."
+ <inline: true>!
Item was added:
+ ----- Method: ObjectMemory>>stringForCString: (in category 'primitive support') -----
+ stringForCString: aCString
+ "Answer a new String copied from a null-terminated C string,
+ or nil if out of memory.
+ Caution: This may invoke the garbage collector."
+ <api>
+ <var: 'aCString' type: 'const char *'>
+ <inline: false>
+ | len newString |
+ len := self strlen: aCString.
+ newString := self instantiateClass: (self splObj: ClassByteString) indexableSize: len.
+ newString ifNotNil:
+ [self st: newString + self baseHeaderSize
+ rn: aCString
+ cpy: len]. "(char *)strncpy()"
+ ^newString!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>ensureNoForwardedLiteralsIn: (in category 'cog jit support') -----
+ ensureNoForwardedLiteralsIn: aMethodObj
+ "Ensure there are no forwarded literals in the argument."
+ <api>
+ self followForwardedObjectFields: aMethodObj toDepth: 0!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceStart newSpaceLimit pastSpaceStart
lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory firstFreeChunk lastFreeChunk)
in: aCCodeGenerator.
self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
in: aCCodeGenerator.
aCCodeGenerator
var: #freeListsMask type: #usqInt;
var: #freeLists type: #'sqInt *';
var: #classTableBitmap type: #'unsigned char *';
var: #objStackInvalidBecause type: #'char *';
var: #highestObjects type: #SpurCircularBuffer;
var: #unscannedEphemerons type: #SpurContiguousObjStack;
var: #heapGrowthToSizeGCRatio type: #float;
var: #heapSizeAtPreviousGC type: #usqInt;
var: #totalFreeOldSpace type: #usqInt.
aCCodeGenerator
var: #remapBuffer
declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
aCCodeGenerator
var: #extraRoots
+ declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.
+ GatherForwardingStatistics ifFalse:
+ [self instVarNames do: [:iv| (iv beginsWith: 'statFollow') ifTrue: [aCCodeGenerator removeVariable: iv]]]!
- declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!
Item was changed:
----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
initialize
"SpurMemoryManager initialize"
BitsPerByte := 8.
+ "A major policy issue for become is whether to follow selectors in method
+ dictionaries eagerly immediately post become, or whether to follow selectors
+ lazily during lookup."
+ FollowMethodDictionariesOnBecome := false.
+ GatherForwardingStatistics := false.
+
"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:."
ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits"
ObjStackTopx := 0.
ObjStackMyx := 1.
ObjStackFreex := 2.
ObjStackNextx := 3.
ObjStackFixedSlots := 4.
ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
"There are currently three obj stacks, the mark stack, the weaklings and the ephemeron queue."
MarkStackRootIndex := self basicNew classTableRootSlots.
WeaklingStackRootIndex := MarkStackRootIndex + 1.
EphemeronQueueRootIndex := MarkStackRootIndex + 2.
MarkObjectsForEnumerationPrimitives := false.
"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>>become:with:twoWay:copyHash: (in category 'become api') -----
become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
"All references to each object in array1 are swapped with all references to the
corresponding object in array2. That is, all pointers to one object are replaced
with with pointers to the other. The arguments must be arrays of the same length.
Answers PrimNoErr if the primitive succeeds, otherwise a relevant error code."
"Implementation: Uses lazy forwarding to defer updating references until message send."
| ec |
self assert: becomeEffectsFlags = 0.
self leakCheckBecome ifTrue:
[self runLeakCheckerForFullGC: true].
(self isArray: array1) ifFalse:
[^PrimErrBadReceiver].
((self isArray: array2)
and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)]) ifFalse:
[^PrimErrBadArgument].
(twoWayFlag or: [copyHashFlag])
ifTrue:
[ec := self containsOnlyValidBecomeObjects: array1 and: array2]
ifFalse:
+ [self forwardingCount: [statFollowForBecome := statFollowForBecome + 1].
+ self followForwardedObjectFields: array2 toDepth: 0.
- [self followForwardedObjectFields: array2 toDepth: 0.
ec := self containsOnlyValidBecomeObjects: array1].
ec ~= 0 ifTrue: [^ec].
coInterpreter preBecomeAction.
twoWayFlag
ifTrue:
[self innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag]
ifFalse:
[self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag].
self postBecomeScanClassTable.
self followSpecialObjectsOop.
coInterpreter postBecomeAction: becomeEffectsFlags.
becomeEffectsFlags := 0.
self leakCheckBecome ifTrue:
[self runLeakCheckerForFullGC: true].
^PrimNoErr "success"!
Item was changed:
----- Method: SpurMemoryManager>>clone: (in category 'allocation') -----
clone: objOop
+ | numSlots fmt newObj |
- | numSlots newObj |
numSlots := self numSlotsOf: objOop.
+ fmt := self formatOf: objOop.
-
numSlots > self maxSlotsForNewSpaceAlloc
ifTrue:
[newObj := self allocateSlotsInOldSpace: numSlots
+ format: fmt
- format: (self formatOf: objOop)
classIndex: (self classIndexOf: objOop)]
ifFalse:
[newObj := self allocateSlots: numSlots
+ format: fmt
- format: (self formatOf: objOop)
classIndex: (self classIndexOf: objOop)].
+ newObj ifNil:
+ [^0].
+ (self isPointersFormat: fmt)
- (self isPointersNonImm: objOop)
ifTrue:
[| hasYoung |
hasYoung := false.
0 to: numSlots - 1 do:
[:i| | oop |
oop := self fetchPointer: i ofObject: objOop.
+ (self isNonImmediate: oop) ifTrue:
+ [(self isForwarded: oop) ifTrue:
+ [oop := self followForwarded: oop].
+ ((self isNonImmediate: oop)
+ and: [self isYoungObject: oop]) ifTrue:
+ [hasYoung := true]].
- ((self isNonImmediate: oop)
- and: [self isForwarded: oop]) ifTrue:
- [oop := self followForwarded: oop].
- ((self isNonImmediate: oop)
- and: [self isYoungObject: oop]) ifTrue:
- [hasYoung := true].
self storePointerUnchecked: i
ofObject: newObj
withValue: oop].
(hasYoung
and: [(self isYoungObject: newObj) not]) ifTrue:
[scavenger remember: newObj.
self setIsRememberedOf: newObj to: true]]
ifFalse:
[0 to: numSlots - 1 do:
[:i|
self storePointerUnchecked: i
ofObject: newObj
+ withValue: (self fetchPointer: i ofObject: objOop)].
+ "N.B. primitiveClone takes care of making sure the method's header is correct"
+ (fmt >= self firstCompiledMethodFormat
+ and: [(self isOldObject: newObj)
+ and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]]) ifTrue:
+ [scavenger remember: newObj.
+ self setIsRememberedOf: newObj to: true]].
- withValue: (self fetchPointer: i ofObject: objOop)]].
^newObj!
Item was added:
+ ----- Method: SpurMemoryManager>>followMaybeForwardedSelector:into: (in category 'object access') -----
+ followMaybeForwardedSelector: oop into: aBlock
+ "Policy switch for selector access in method dictionaries.
+ If FollowMethodDictionariesOnBecome then selectors have
+ already been followed. If not, follow lazily."
+ <inline: true>
+ FollowMethodDictionariesOnBecome ifFalse:
+ [| field |
+ field := oop.
+ [self isOopForwarded: field] whileTrue:
+ [field := self fetchPointer: 0 ofMaybeForwardedObject: field].
+ aBlock value: field]!
Item was changed:
----- Method: SpurMemoryManager>>followSpecialObjectsOop (in category 'become implementation') -----
followSpecialObjectsOop
+ self forwardingCount: [statFollowSpecialObjects := statFollowSpecialObjects + 1].
(self isForwarded: specialObjectsOop) ifTrue:
[specialObjectsOop := self followForwarded: specialObjectsOop].
self followForwardedObjectFields: specialObjectsOop toDepth: 0.!
Item was added:
+ ----- Method: SpurMemoryManager>>forwardingCount: (in category 'forwarding') -----
+ forwardingCount: aBlock
+ "Hook for turning on and off statistics gathering on forwarding"
+ <inline: true>
+ GatherForwardingStatistics ifTrue: [aBlock value]!
Item was added:
+ ----- Method: SpurMemoryManager>>forwardingStatsWith:with:with:with:with:with: (in category 'primitive support') -----
+ forwardingStatsWith: statFollowCurrentMethodArg with: statFollowForPrimFailArg with: statFollowForSelectorFaultArg with: statFollowForSendFaultArg with: statFollowForSignalArg with: statFollowForSpecialSelectorArg
+ <option: #GatherForwardingStatistics>
+ | stats name |
+ stats := self allocateSlots: 20 format: self arrayFormat classIndex: ClassArrayCompactIndex.
+ stats ifNil: [^nil].
+ name := self stringForCString: 'statFollowCurrentMethod'.
+ name ifNil: [^nil].
+ self storePointer: 0 ofObject: stats withValue: name.
+ self storePointerUnchecked: 1 ofObject: stats withValue: (self integerObjectOf: statFollowCurrentMethodArg).
+ name := self stringForCString: 'statFollowForBecome'.
+ name ifNil: [^nil].
+ self storePointer: 2 ofObject: stats withValue: name.
+ self storePointerUnchecked: 3 ofObject: stats withValue: (self integerObjectOf: statFollowForBecome).
+ name := self stringForCString: 'statFollowForClassTable'.
+ name ifNil: [^nil].
+ self storePointer: 4 ofObject: stats withValue: name.
+ self storePointerUnchecked: 5 ofObject: stats withValue: (self integerObjectOf: statFollowForClassTable).
+ name := self stringForCString: 'statFollowForJIT'.
+ name ifNil: [^nil].
+ self storePointer: 6 ofObject: stats withValue: name.
+ self storePointerUnchecked: 7 ofObject: stats withValue: (self integerObjectOf: statFollowForJIT).
+ name := self stringForCString: 'statFollowForPrimFail'.
+ name ifNil: [^nil].
+ self storePointer: 8 ofObject: stats withValue: name.
+ self storePointerUnchecked: 9 ofObject: stats withValue: (self integerObjectOf: statFollowForPrimFailArg).
+ name := self stringForCString: 'statFollowForSelectorFault'.
+ name ifNil: [^nil].
+ self storePointer: 10 ofObject: stats withValue: name.
+ self storePointerUnchecked: 11 ofObject: stats withValue: (self integerObjectOf: statFollowForSelectorFaultArg).
+ name := self stringForCString: 'statFollowForSendFault'.
+ name ifNil: [^nil].
+ self storePointer: 12 ofObject: stats withValue: name.
+ self storePointerUnchecked: 13 ofObject: stats withValue: (self integerObjectOf: statFollowForSendFaultArg).
+ name := self stringForCString: 'statFollowForSignal'.
+ name ifNil: [^nil].
+ self storePointer: 14 ofObject: stats withValue: name.
+ self storePointerUnchecked: 15 ofObject: stats withValue: (self integerObjectOf: statFollowForSignalArg).
+ name := self stringForCString: 'statFollowForSpecialSelector'.
+ name ifNil: [^nil].
+ self storePointer: 16 ofObject: stats withValue: name.
+ self storePointerUnchecked: 17 ofObject: stats withValue: (self integerObjectOf: statFollowForSpecialSelectorArg).
+ name := self stringForCString: 'statFollowSpecialObjects'.
+ name ifNil: [^nil].
+ self storePointer: 18 ofObject: stats withValue: name.
+ self storePointerUnchecked: 19 ofObject: stats withValue: (self integerObjectOf: statFollowSpecialObjects).
+ ^stats!
Item was changed:
----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
initialize
"We can put all initializations that set something to 0 or to false here.
In C all global variables are initialized to 0, and 0 is false."
remapBuffer := Array new: RemapBufferSize.
remapBufferCount := extraRootCount := 0. "see below"
freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
checkForLeaks := 0.
needGCFlag := signalLowSpace := scavengeInProgress := marking := false.
becomeEffectsFlags := 0.
statScavenges := statIncrGCs := statFullGCs := 0.
statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
statGrowMemory := statShrinkMemory := statRootTableCount := statSurvivorCount := 0.
statRootTableOverflows := statMarkCount := statSpecialMarkCount := statCompactPassCount := statCoalesces := 0.
+ statFollowForJIT := statFollowForBecome := statFollowForClassTable := statFollowSpecialObjects := 0.
"We can initialize things that are allocated but are lazily initialized."
unscannedEphemerons := SpurContiguousObjStack new.
"we can initialize things that are virtual in C."
scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
segmentManager := SpurSegmentManager new manager: self; yourself.
"We can also initialize here anything that is only for simulation."
heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
"N.B. We *don't* initialize extraRoots because we don't simulate it."!
Item was changed:
----- Method: SpurMemoryManager>>isForwarded: (in category 'object testing') -----
isForwarded: objOop
"Answer if objOop is that if a forwarder. Take advantage of isForwardedObjectClassIndexPun
being a power of two to generate a more efficient test than the straight-forward
(self classIndexOf: objOop) = self isForwardedObjectClassIndexPun
at the cost of this being ambiguous with free chunks. So either never apply this to free chunks
or guard with (self isFreeObject: foo) not. So far the idiom has been to guard with isFreeObject:"
<api>
+ <inline: true>
+ "self assert: (self isFreeObject: objOop) not."
- self assert: (self isFreeObject: objOop) not.
^(self longAt: objOop) noMask: self classIndexMask - self isForwardedObjectClassIndexPun!
Item was added:
+ ----- Method: SpurMemoryManager>>numSlotsForBytes: (in category 'header format') -----
+ numSlotsForBytes: numBytes
+ ^numBytes + (self wordSize - 1) / self wordSize!
Item was changed:
----- Method: SpurMemoryManager>>possibleRootStoreInto: (in category 'store check') -----
possibleRootStoreInto: destObj
+ <inline: false>
(self isRemembered: destObj) ifFalse:
[scavenger remember: destObj.
self setIsRememberedOf: destObj to: true]!
Item was changed:
----- Method: SpurMemoryManager>>scanClassPostBecome:effects: (in category 'become implementation') -----
scanClassPostBecome: startClassObj effects: becomeEffects
"Scan a class in the class table post-become. Make sure the superclass
chain contains no forwarding pointers, and that the method dictionaries
are not forwarded either. N.B. we don't follow methods or their
methodClassAssociations since we can't guarantee that forwarders
to compiled methods are not stored in method dictionaries via at:put:
and so have to cope with forwarding pointers to compiled methods
in method dictionaries anyway. Instead the [Co]Interpreter must
follow forwarders when fetching from method dictionaries and follow
forwarders on become in the method cache and method zone."
| classObj obj |
"Algorithm depends on this to terminate loop at root of superclass chain."
self assert: (self rawHashBitsOf: nilObj) ~= 0.
self assert: (becomeEffects anyMask: BecamePointerObjectFlag). "otherwise why bother?"
classObj := startClassObj.
["e.g. the Newspeak bootstrap creates fake classes that contain bogus superclasses.
Hence be cautious."
((self isPointers: classObj)
and: [(self numSlotsOf: classObj) > MethodDictionaryIndex]) ifFalse:
[^self].
obj := self followObjField: MethodDictionaryIndex ofObject: classObj.
+ "Solving the becommed method stored into a method dictionary object issue is easy;
+ just have a read barrier on fetching the method. But solving the read barrier for
+ selectors is more difficult (because selectors are currently not read, just their oops).
+ For now provide a policy switch that either follows on become or lazily on lookup."
- "Solving the becommed method stored into a method dictionary object issue is
- easy; just have a read barrier on fetching the method. But solving the read barrier
- for selectors is more difficult (because selectors are currently not read, just their
- oops). For now punt on the issue and simply follow all selectors on become"
self flag: 'need to fix the selector and methodDictionary issue'.
+ self forwardingCount: [statFollowForBecome := statFollowForBecome + 1].
+ FollowMethodDictionariesOnBecome
- true
ifTrue: [self followForwardedObjectFields: obj toDepth: 0]
ifFalse: [self followObjField: MethodArrayIndex ofObject: obj].
obj := self followObjField: SuperclassIndex ofObject: classObj.
"If the superclass has an identityHash then either it is nil, or is in the class table.
Tail recurse."
(self rawHashBitsOf: obj) = 0] whileTrue:
["effectively self scanClassPostBecome: obj"
classObj := obj]!
Item was added:
+ ----- Method: SpurMemoryManager>>stringForCString: (in category 'primitive support') -----
+ stringForCString: aCString
+ "Answer a new String copied from a null-terminated C string,
+ or nil if out of memory."
+ <api>
+ <var: 'aCString' type: 'const char *'>
+ <inline: false>
+ | len newString |
+ len := self strlen: aCString.
+ newString := self
+ allocateSlots: (self numSlotsForBytes: len)
+ format: (self byteFormatForNumBytes: len)
+ classIndex: ClassByteStringCompactIndex.
+ newString ifNotNil:
+ [self st: newString + self baseHeaderSize
+ rn: aCString
+ cpy: len]. "(char *)strncpy()"
+ ^newString!
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 primitiveAccessorDepthTable 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 checkAllocFiller tempOop theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals statFollowCurrentMethod statFollowForSendFault statFollowForSignal statFollowForPrimFail statFollowForSelectorFault statFollowForSpecialSelector'
- 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 primitiveAccessorDepthTable 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 checkAllocFiller tempOop theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
classVariableNames: 'AltBytecodeEncoderClassName AltLongStoreBytecode AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached'
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 class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
aCCodeGenerator
addHeaderFile:'<stddef.h> /* for e.g. alloca */';
addHeaderFile:'<setjmp.h>';
addHeaderFile:'"vmCallback.h"';
addHeaderFile:'"sqMemoryFence.h"';
addHeaderFile:'"dispdbg.h"'.
self declareInterpreterVersionIn: aCCodeGenerator
defaultName: 'Stack'.
aCCodeGenerator
var: #interpreterProxy type: #'struct VirtualMachine*'.
aCCodeGenerator
declareVar: #sendTrace type: 'volatile int';
declareVar: #byteCount type: 'unsigned long'.
"These need to be pointers or unsigned."
self declareC: #(instructionPointer method newMethod)
as: #usqInt
in: aCCodeGenerator.
"These are all pointers; char * because Slang has no support for C pointer arithmetic."
self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit stackMemory)
as: #'char *'
in: aCCodeGenerator.
self declareC: #(stackPage overflowedPage)
as: #'StackPage *'
in: aCCodeGenerator.
aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code."
"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
is not defined, for the benefit of the interpreter on slow machines."
aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
MULTIPLEBYTECODESETS == false ifTrue:
[aCCodeGenerator
removeVariable: 'extA';
removeVariable: 'extB';
removeVariable: 'bytecodeSetSelector'].
+ (self objectMemoryClass classPool at: #GatherForwardingStatistics ifAbsent: [false]) ifFalse:
+ [self instVarNames do: [:iv| (iv beginsWith: 'statFollow') ifTrue: [aCCodeGenerator removeVariable: iv]]].
aCCodeGenerator
var: #methodCache
declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
aCCodeGenerator
var: #atCache
declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'.
aCCodeGenerator
var: #primitiveTable
declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', self primitiveTableString.
self primitiveTable do:
[:symbolOrNot|
(symbolOrNot isSymbol
and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
[:tMethod| tMethod returnType: #void]]].
self objectMemoryClass hasSpurMemoryManagerAPI
ifTrue:
[aCCodeGenerator
var: #primitiveAccessorDepthTable
type: 'signed char'
sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
array: self primitiveAccessorDepthTable]
ifFalse:
[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
aCCodeGenerator
var: #primitiveFunctionPointer
declareC: 'void (*primitiveFunctionPointer)()'.
aCCodeGenerator
var: #externalPrimitiveTable
declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
aCCodeGenerator var: #showSurfaceFn type: #'void *'.
aCCodeGenerator
var: #jmpBuf
declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
aCCodeGenerator
var: #suspendedCallbacks
declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
aCCodeGenerator
var: #suspendedMethods
declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
aCCodeGenerator
var: #interruptCheckChain
declareC: 'void (*interruptCheckChain)(void) = 0'.
aCCodeGenerator
var: #breakSelector type: #'char *';
var: #breakSelectorLength
declareC: 'sqInt breakSelectorLength = -1'.
self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
statProcessSwitch statIOProcessEvents statForceInterruptCheck
statCheckForEvents statStackOverflow statStackPageDivorce)
in: aCCodeGenerator.
aCCodeGenerator var: #nextProfileTick type: #sqLong!
Item was changed:
----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveStateFor: (in category 'primitive support') -----
checkForAndFollowForwardedPrimitiveStateFor: primIndex
"In Spur a primitive may fail due to encountering a forwarder.
On failure check the accessorDepth for the primitive and
if non-negative scan the args to the depth, following any
forwarders. Answer if any are found so the prim can be retried."
<option: #SpurObjectMemory>
| accessorDepth found |
self assert: self successful not.
found := false.
accessorDepth := primitiveAccessorDepthTable at: primIndex.
"For the method-executing primitives, failure could have been in those primitives or the
primitives of the methods they execute. find out which failed by seeing what is in effect."
primIndex caseOf: {
[117] ->
[primitiveFunctionPointer ~~ #primitiveExternalCall ifTrue:
[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
self assert: argumentCount = (self argumentCountOf: newMethod)].
[118] -> "with tryPrimitive:withArgs: the argument count has nothing to do with newMethod's, so no arg count assert."
[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)].
[218] ->
[primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs ifTrue:
[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
self assert: argumentCount = (self argumentCountOf: newMethod)]. }
otherwise:
["functionPointer should have been set, unless we're in machine code"
instructionPointer > objectMemory nilObject ifTrue:
[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject).
self assert: argumentCount = (self argumentCountOf: newMethod)]].
accessorDepth >= 0 ifTrue:
[0 to: argumentCount do:
[:index| | oop |
oop := self stackValue: index.
(objectMemory isNonImmediate: oop) ifTrue:
[(objectMemory isForwarded: oop) ifTrue:
[self assert: index < argumentCount. "receiver should have been caught at send time."
found := true.
oop := objectMemory followForwarded: oop.
self stackValue: index put: oop].
((objectMemory hasPointerFields: oop)
and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
+ [objectMemory forwardingCount: [statFollowForPrimFail := statFollowForPrimFail + 1].
+ found := true]]]].
- [found := true]]]].
^found!
Item was changed:
----- Method: StackInterpreter>>followForwardedFieldsInCurrentMethod (in category 'message sending') -----
followForwardedFieldsInCurrentMethod
+ objectMemory forwardingCount: [statFollowCurrentMethod := statFollowCurrentMethod + 1].
objectMemory
followForwardedObjectFields: method
toDepth: 0!
Item was changed:
----- Method: StackInterpreter>>handleForwardedSelectorFaultFor: (in category 'message sending') -----
handleForwardedSelectorFaultFor: selectorOop
"Handle a send fault that is due to a send using a forwarded selector.
Unforward the selector and follow the current method and special
selectors array to unforward the source of the forwarded selector."
<option: #SpurObjectMemory>
<inline: false>
self assert: (objectMemory isOopForwarded: selectorOop).
self followForwardedFieldsInCurrentMethod.
+ objectMemory forwardingCount: [statFollowForSelectorFault := statFollowForSelectorFault + 1].
objectMemory
followForwardedObjectFields: (objectMemory splObj: SpecialSelectors)
toDepth: 0.
^objectMemory followForwarded: selectorOop!
Item was changed:
----- Method: StackInterpreter>>handleForwardedSendFaultForTag: (in category 'message sending') -----
handleForwardedSendFaultForTag: classTag
"Handle a send fault that may be due to a send to a forwarded object.
Unforward the receiver on the stack and answer its actual class."
<option: #SpurObjectMemory>
| rcvr |
<inline: false>
self assert: (objectMemory isForwardedClassTag: classTag).
rcvr := self stackValue: argumentCount.
"should *not* be a super send, so the receiver should be forwarded."
self assert: (objectMemory isOopForwarded: rcvr).
rcvr := objectMemory followForwarded: rcvr.
self stackValue: argumentCount put: rcvr.
self followForwardedFrameContents: framePointer
stackPointer: stackPointer + (argumentCount + 1 * BytesPerWord). "don't repeat effort"
(objectMemory isPointers: (self frameReceiver: framePointer)) ifTrue:
+ [objectMemory forwardingCount: [statFollowForSendFault := statFollowForSendFault + 1].
+ objectMemory
- [objectMemory
followForwardedObjectFields: (self frameReceiver: framePointer)
toDepth: 0].
^objectMemory fetchClassTagOf: rcvr!
Item was changed:
----- Method: StackInterpreter>>handleSpecialSelectorSendFaultFor:fp:sp: (in category 'message sending') -----
handleSpecialSelectorSendFaultFor: obj fp: theFP sp: theSP
"Handle a special send fault that may be due to a special selector
send accessing a forwarded object.
Unforward the object on the stack and in inst vars and answer its target."
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
self assert: (objectMemory isOopForwarded: obj).
self followForwardedFrameContents: theFP stackPointer: theSP.
(objectMemory isPointers: (self frameReceiver: theFP)) ifTrue:
+ [objectMemory forwardingCount: [statFollowForSpecialSelector := statFollowForSpecialSelector + 1].
+ objectMemory
- [objectMemory
followForwardedObjectFields: (self frameReceiver: theFP)
toDepth: 0].
^objectMemory followForwarded: obj!
Item was added:
+ ----- Method: StackInterpreter>>initialize (in category 'initialization') -----
+ initialize
+ "Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated."
+ checkAllocFiller := false. "must preceed initializeObjectMemory:"
+ primFailCode := 0.
+ stackLimit := 0. "This is also the initialization flag for the stack system."
+ stackPage := overflowedPage := 0.
+ extraFramesToMoveOnOverflow := 0.
+ bytecodeSetSelector := 0.
+ highestRunnableProcessPriority := 0.
+ nextProfileTick := 0.
+ nextPollUsecs := 0.
+ nextWakeupUsecs := 0.
+ tempOop := theUnknownShort := 0.
+ interruptPending := false.
+ inIOProcessEvents := 0.
+ fullScreenFlag := 0.
+ deferDisplayUpdates := false.
+ pendingFinalizationSignals := statPendingFinalizationSignals := 0.
+ globalSessionID := 0.
+ jmpDepth := 0.
+ longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
+ maxExtSemTabSizeSet := false.
+ statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
+ statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0.
+ statFollowCurrentMethod := statFollowForSendFault := statFollowForSignal :=
+ statFollowForPrimFail := statFollowForSelectorFault := statFollowForSpecialSelector := 0
+ !
Item was changed:
----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') -----
+ initializeInterpreter: bytesToShift
- initializeInterpreter: bytesToShift
"Initialize Interpreter state before starting execution of a new image."
interpreterProxy := self sqGetInterpreterProxy.
self dummyReferToProxy.
- checkAllocFiller := false. "must preceed initializeObjectMemory:"
objectMemory initializeObjectMemory: bytesToShift.
self checkAssumedCompactClasses.
- primFailCode := 0.
self initializeExtraClassInstVarIndices.
- stackLimit := 0. "This is also the initialization flag for the stack system."
- stackPage := overflowedPage := 0.
- extraFramesToMoveOnOverflow := 0.
method := newMethod := objectMemory nilObject.
- self cCode: [self cppIf: MULTIPLEBYTECODESETS ifTrue: [bytecodeSetSelector := 0]]
- inSmalltalk: [bytecodeSetSelector := 0].
methodDictLinearSearchLimit := 8.
self flushMethodCache.
self flushAtCache.
self initialCleanup.
+ profileSemaphore := profileProcess := profileMethod := objectMemory nilObject.
- highestRunnableProcessPriority := 0.
- nextProfileTick := 0.
- profileSemaphore := objectMemory nilObject.
- profileProcess := objectMemory nilObject.
- profileMethod := objectMemory nilObject.
- nextPollUsecs := 0.
- nextWakeupUsecs := 0.
- tempOop := theUnknownShort := 0.
interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
- interruptPending := false.
- inIOProcessEvents := 0.
- fullScreenFlag := 0.
- deferDisplayUpdates := false.
- pendingFinalizationSignals := statPendingFinalizationSignals := 0.
- globalSessionID := 0.
[globalSessionID = 0] whileTrue:
[globalSessionID := self
+ cCode: [(self time: #NULL) + self ioMSecs]
+ inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]]!
- cCode: [(self time: #NULL) + self ioMSecs]
- inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
- jmpDepth := 0.
- longRunningPrimitiveStartUsecs :=
- longRunningPrimitiveStopUsecs := 0.
- maxExtSemTabSizeSet := false.
- statForceInterruptCheck := 0.
- statStackOverflow := 0.
- statCheckForEvents := 0.
- statProcessSwitch := 0.
- statIOProcessEvents := 0.
- statStackPageDivorce := 0!
Item was changed:
----- Method: StackInterpreter>>lookupMethodFor:InDictionary: (in category 'message sending') -----
lookupMethodFor: selector InDictionary: dictionary
"Lookup the argument selector in aDictionary and answer either the
method or nil, if not found.
This method lookup tolerates integers as Dictionary keys to support
execution of images in which Symbols have been compacted out."
| length index mask wrapAround nextSelector methodArray |
<inline: true>
<asmLabel: false>
length := objectMemory fetchWordLengthOf: dictionary.
mask := length - SelectorStart - 1.
index := SelectorStart + (mask bitAnd: ((objectMemory isImmediate: selector)
ifTrue: [objectMemory integerValueOf: selector]
ifFalse: [objectMemory hashBitsOf: selector])).
"It is assumed that there are some nils in this dictionary, and search will
stop when one is encountered. However, if there are no nils, then wrapAround
will be detected the second time the loop gets to the end of the table."
wrapAround := false.
[true] whileTrue:
[nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
nextSelector = objectMemory nilObject ifTrue:
[^nil].
+ objectMemory
+ followMaybeForwardedSelector: nextSelector
+ into: [:followed| nextSelector := followed].
nextSelector = selector ifTrue:
[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
^objectMemory fetchPointer: index - SelectorStart ofObject: methodArray].
index := index + 1.
index = length ifTrue:
[wrapAround ifTrue: [^nil].
wrapAround := true.
index := SelectorStart]].
^nil "for Slang"!
Item was changed:
----- Method: StackInterpreter>>lookupMethodInDictionary: (in category 'message sending') -----
lookupMethodInDictionary: dictionary
"This method lookup tolerates integers as Dictionary keys to support
execution of images in which Symbols have been compacted out."
| length index mask wrapAround nextSelector methodArray |
<inline: true>
<asmLabel: false>
length := objectMemory fetchWordLengthOf: dictionary.
mask := length - SelectorStart - 1.
"Use linear search on small dictionaries; its cheaper.
Also the limit can be set to force linear search of all dictionaries, which supports the
booting of images that need rehashing (e.g. because a tracer has generated an image
with different hashes but hasn't rehashed it yet.)"
mask <= methodDictLinearSearchLimit ifTrue:
[index := 0.
[index <= mask] whileTrue:
[nextSelector := objectMemory fetchPointer: index + SelectorStart ofObject: dictionary.
+ objectMemory
+ followMaybeForwardedSelector: nextSelector
+ into: [:followed| nextSelector := followed].
nextSelector = messageSelector ifTrue:
[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
newMethod := objectMemory followField: index ofObject: methodArray.
^true].
index := index + 1].
^false].
index := SelectorStart + (mask bitAnd: ((objectMemory isImmediate: messageSelector)
ifTrue: [objectMemory integerValueOf: messageSelector]
ifFalse: [objectMemory hashBitsOf: messageSelector])).
"It is assumed that there are some nils in this dictionary, and search will
stop when one is encountered. However, if there are no nils, then wrapAround
will be detected the second time the loop gets to the end of the table."
wrapAround := false.
[true] whileTrue:
[nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
nextSelector = objectMemory nilObject ifTrue: [^false].
+ objectMemory
+ followMaybeForwardedSelector: nextSelector
+ into: [:followed| nextSelector := followed].
nextSelector = messageSelector ifTrue:
[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
newMethod := objectMemory followField: index - SelectorStart ofObject: methodArray.
^true].
index := index + 1.
index = length ifTrue:
[wrapAround ifTrue: [^false].
wrapAround := true.
index := SelectorStart]].
^false "for Slang"!
Item was removed:
- ----- Method: StackInterpreter>>stringForCString: (in category 'primitive support') -----
- stringForCString: aCString
- "Answer a new String copied from a null-terminated C string,
- or nil if out of memory.
- Caution: This may invoke the garbage collector."
- <api>
- <var: 'aCString' type: 'const char *'>
- | len newString |
- len := self strlen: aCString.
- newString := objectMemory instantiateClass: objectMemory classString indexableSize: len.
- newString isNil ifFalse:
- [self st: (self arrayValueOf: newString)
- rn: aCString
- cpy: len]. "(char *)strncpy()"
- ^newString!
Item was changed:
----- Method: StackInterpreter>>synchronousSignal: (in category 'process primitive support') -----
synchronousSignal: aSemaphore
"Signal the given semaphore from within the interpreter.
Answer if the current process was preempted."
| excessSignals |
<inline: false>
(self isEmptyList: aSemaphore) ifTrue:
["no process is waiting on this semaphore"
excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: aSemaphore.
self storeInteger: ExcessSignalsIndex
ofObject: aSemaphore
withValue: excessSignals + 1.
^false].
objectMemory hasSpurMemoryManagerAPI ifTrue:
[| firstLink |
firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aSemaphore.
(objectMemory isForwarded: firstLink) ifTrue:
["0 = aSemaphore, 1 = aProcess. Hence reference to suspendedContext will /not/ be forwarded."
+ objectMemory forwardingCount: [statFollowForSignal := statFollowForSignal + 1].
objectMemory followForwardedObjectFields: aSemaphore toDepth: 1].
self assert: (objectMemory isForwarded: (objectMemory fetchPointer: SuspendedContextIndex ofObject: firstLink)) not].
^self resume: (self removeFirstLinkOfList: aSemaphore)
preemptedYieldingIf: preemptionYields!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveForwardingStats (in category 'system control primitives') -----
+ primitiveForwardingStats
+ <export: true>
+ <option: #GatherForwardingStatistics>
+ | stats |
+ stats := objectMemory
+ forwardingStatsWith: statFollowCurrentMethod
+ with: statFollowForPrimFail
+ with: statFollowForSelectorFault
+ with: statFollowForSendFault
+ with: statFollowForSignal
+ with: statFollowForSpecialSelector.
+ stats ifNil:
+ [^self primitiveFailFor: PrimErrNoMemory].
+ self methodReturnValue: stats!
More information about the Vm-dev
mailing list