Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.838.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.838
Author: eem
Time: 29 July 2014, 8:20:21.403 am
UUID: 5430ce8e-3e58-4a34-b27f-e769a981ee6a
Ancestors: VMMaker.oscog-eem.837
General:
Fix slips in the new fetch/storeShort16/Long64 methods
which expect a 0-relative index. Fix failure to convert
integer to integer value in the revised primitiveShortAt[Put].
Change the scanning for initial nils scheme in the
StackToRegisterMappingCogit to answer the number of
push nils in a bytecode, instead of whether the bytecode
is a push nil. Refactor genReturnTopFromBlock into
genBlockReturn. These changes accomodate Sista.
Sista:
Generate a few more bytecodes.
Simulator:
Fingers crossed, fix the inconsistent values in the balloon
code by making sure that primitiveShortAt: answers
signed values; the old code answered unsigned values.
=============== Diff against VMMaker.oscog-eem.837 ===============
Item was changed:
----- Method: InterpreterPrimitives>>primitiveShortAt (in category 'sound primitives') -----
primitiveShortAt
+ "Treat the receiver, which can be indexible by either bytes or words, as
+ an array of signed 16-bit values. Answer the contents of the given index.
+ Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
- "Treat the receiver, which can be indexible by either bytes or words, as an array of signed 16-bit values. Return the contents of the given index. Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
| index rcvr value |
index := self stackTop..
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
rcvr := self stackValue: 1.
(objectMemory isWordsOrBytes: rcvr) ifFalse:
[^self primitiveFailFor: PrimErrInappropriate].
+ index := objectMemory integerValueOf: index.
((index >= 1) and: [index <= (objectMemory num16BitUnitsOf: rcvr)]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
value := objectMemory fetchShort16: index - 1 ofObject: rcvr.
+ self cCode: []
+ inSmalltalk: [value > 32767 ifTrue: [value := value - 65536]].
self pop: 2 thenPushInteger: value!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveShortAtPut (in category 'sound primitives') -----
primitiveShortAtPut
"Treat the receiver, which can be indexible by either bytes or words, as an array
of signed 16-bit values. Set the contents of the given index to the given value.
Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
| index rcvr value |
value := self stackTop.
index := self stackValue: 1.
((objectMemory isIntegerObject: value)
and: [(objectMemory isIntegerObject: index)
and: [value := objectMemory integerValueOf: value.
(value >= -32768) and: [value <= 32767]]]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
rcvr := self stackValue: 2.
(objectMemory isWordsOrBytes: rcvr) ifFalse:
[^self primitiveFailFor: PrimErrInappropriate].
+ index := objectMemory integerValueOf: index.
(index >= 1 and: [index <= (objectMemory num16BitUnitsOf: rcvr)]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
objectMemory storeShort16: index - 1 ofObject: rcvr withValue: value.
self pop: 3 thenPush: (objectMemory integerObjectOf: value)!
Item was changed:
----- Method: ObjectMemory>>fetchLong64:ofObject: (in category 'object access') -----
fetchLong64: longIndex ofObject: oop
<returnTypeC: #sqLong>
+ ^self long64At: oop + BaseHeaderSize + (longIndex << 3)!
- ^self long64At: oop + BaseHeaderSize + (8 * (longIndex - 1))!
Item was changed:
----- Method: ObjectMemory>>fetchShort16:ofObject: (in category 'object access') -----
fetchShort16: shortIndex ofObject: oop
+ ^self shortAt: oop + BaseHeaderSize + (shortIndex << 1)!
- ^self shortAt: oop + BaseHeaderSize + (2 * (shortIndex - 1))!
Item was changed:
----- Method: ObjectMemory>>storeLong64:ofObject:withValue: (in category 'object access') -----
storeLong64: longIndex ofObject: oop withValue: value
<var: #value type: #sqLong>
+ ^self long64At: oop + BaseHeaderSize + (longIndex << 3) put: value!
- ^self long64At: oop + BaseHeaderSize + (8 * (longIndex - 1)) put: value!
Item was changed:
----- Method: ObjectMemory>>storeShort16:ofObject:withValue: (in category 'object access') -----
storeShort16: shortIndex ofObject: oop withValue: value
+ ^self shortAt: oop + BaseHeaderSize + (shortIndex << 1) put: value!
- ^self shortAt: oop + BaseHeaderSize + (2 * (shortIndex - 1)) put: value!
Item was changed:
----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
initializeBytecodeTableForSistaV1
"SimpleStackBasedCogit initializeBytecodeTableForSistaV1"
self flag:
'Special selector send class must be inlined to agree with the interpreter, which
inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
have identical semantics. We get away with not hardwiring the other special
selectors either because in the Cointerpreter they are not inlined or because they
are inlined only to instances of classes for which there will always be a method.'.
self generatorTableFrom: #(
"1 byte bytecodes"
"pushes"
(1 0 15 genPushReceiverVariableBytecode)
(1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
(1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
(1 64 75 genPushTemporaryVariableBytecode)
(1 76 76 genPushReceiverBytecode)
+ (1 77 77 genPushConstantTrueBytecode needsFrameNever: 1)
+ (1 78 78 genPushConstantFalseBytecode needsFrameNever: 1)
+ (1 79 79 genPushConstantNilBytecode needsFrameNever: 1)
- (1 77 77 pushConstantTrueBytecode needsFrameNever: 1)
- (1 78 78 pushConstantFalseBytecode needsFrameNever: 1)
- (1 79 79 pushConstantNilBytecode needsFrameNever: 1)
(1 80 80 genPushConstantZeroBytecode needsFrameNever: 1)
(1 81 81 genPushConstantOneBytecode needsFrameNever: 1)
(1 82 82 genExtPushPseudoVariable)
(1 83 83 duplicateTopBytecode needsFrameNever: 1)
(1 84 87 unknownBytecode)
"returns"
(1 88 88 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
(1 89 89 genReturnTrue return needsFrameIfInBlock: isMappedInBlock 0)
(1 90 90 genReturnFalse return needsFrameIfInBlock: isMappedInBlock 0)
(1 91 91 genReturnNil return needsFrameIfInBlock: isMappedInBlock 0)
(1 92 92 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
(1 93 93 genReturnNilFromBlock return needsFrameNever: -1)
(1 94 94 genReturnTopFromBlock return needsFrameNever: -1)
+ (1 95 95 genExtNopBytecode needsFrameNever: 0)
- (1 95 95 genExtNop needsFrameNever: 0)
"sends"
(1 96 117 genSpecialSelectorSend isMapped) "#+ #- #< #> #<= #>= #= #~= #* #/ #\\ #@ #bitShift: #// #bitAnd: #bitOr: #at: #at:put: #size #next #nextPut: #atEnd"
(1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
(1 119 119 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)"
(1 120 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
(1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
(1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
(1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
"jumps"
(1 176 183 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
(1 184 191 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(1 192 199 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
"stores"
(1 200 207 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
(1 208 215 genStoreAndPopTemporaryVariableBytecode)
(1 216 216 genPopStackBytecode needsFrameNever: -1)
(1 217 223 unknownBytecode)
"2 byte bytecodes"
(2 224 224 extABytecode extension)
(2 225 225 extBBytecode extension)
"pushes"
(2 226 226 genExtPushReceiverVariableBytecode)
(2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1)
(2 228 228 genExtPushLiteralBytecode needsFrameNever: 1)
(2 229 229 genLongPushTemporaryVariableBytecode)
(2 230 230 genPushClosureTempsBytecode)
(2 231 231 genPushNewArrayBytecode)
(2 232 232 genExtPushIntegerBytecode needsFrameNever: 1)
(2 233 233 genExtPushCharacterBytecode needsFrameNever: 1)
"returns"
"sends"
(2 234 234 genExtSendBytecode isMapped)
(2 235 235 genExtSendSuperBytecode isMapped)
"sista bytecodes"
(2 236 236 genExtTrapIfNotInstanceOfBehaviorsBytecode isMapped)
"jumps"
(2 237 237 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
(2 238 238 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
(2 239 239 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
"stores"
(2 240 240 genExtStoreAndPopReceiverVariableBytecode)
(2 241 241 genExtStoreAndPopLiteralVariableBytecode)
(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
(2 243 243 genExtStoreReceiverVariableBytecode)
(2 244 244 genExtStoreLiteralVariableBytecode)
(2 245 245 genLongStoreTemporaryVariableBytecode)
(2 246 247 unknownBytecode)
"3 byte bytecodes"
(3 248 248 callPrimitiveBytecode)
(3 249 249 unknownBytecode) "reserved for Push Float"
+ (3 250 250 genExtPushClosureBytecode block v4:Block:Code:Size:)
- (3 250 250 genExtPushClosureBytecode block sistaV1:Block:Code:Size:)
(3 251 251 genPushRemoteTempLongBytecode)
(3 252 252 genStoreRemoteTempLongBytecode)
(3 253 253 genStoreAndPopRemoteTempLongBytecode)
(3 254 255 unknownBytecode))!
Item was added:
+ ----- Method: SimpleStackBasedCogit>>genBlockReturn (in category 'bytecode generators') -----
+ genBlockReturn
+ "Return from block, assuming result already loaded into ReceiverResultReg."
+ needsFrame ifTrue:
+ [self MoveR: FPReg R: SPReg.
+ self PopR: FPReg].
+ "Tim, I disagree; link reg should only be popped if frameful.
+ Frameless methods should /not/ push the link reg except around trampolines.
+ Eliot"
+ backEnd hasLinkRegister ifTrue:
+ [self PopR: LinkReg].
+ self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
+ ^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>genExtNopBytecode (in category 'bytecode generators') -----
genExtNopBytecode
+ "NewspeakV4: 221 11011101 Nop"
+ "SistaV1: 91 01011011' Nop"
- "221 11011101 Nop"
extA := extB := 0.
^0!
Item was added:
+ ----- Method: SimpleStackBasedCogit>>genExtPushCharacterBytecode (in category 'bytecode generators') -----
+ genExtPushCharacterBytecode
+ "SistaV1: 233 11101001 iiiiiiii Push Character #iiiiiiii (+ Extend B * 256)"
+ | value |
+ value := byte1 + (extB << 8).
+ extB := 0.
+ ^self genPushLiteral: (objectMemory characterObjectOf: value)!
Item was changed:
----- Method: SimpleStackBasedCogit>>genExtPushIntegerBytecode (in category 'bytecode generators') -----
genExtPushIntegerBytecode
+ "NewsqueakV4: 229 11100101 iiiiiiii Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)
+ SistaV1: 232 11101000 iiiiiiii Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
- "229 11100101 i i i i i i i i Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
| value |
value := byte1 + (extB << 8).
extB := 0.
^self genPushLiteral: (objectMemory integerObjectOf: value)!
Item was added:
+ ----- Method: SimpleStackBasedCogit>>genExtPushPseudoVariable (in category 'bytecode generators') -----
+ genExtPushPseudoVariable
+ "SistaV1: * 82 01010010 Push thisContext, (then Extend B = 1 => push thisProcess)"
+ | ext |
+ ext := extB.
+ extB := 0.
+ ext caseOf: {
+ [0] -> [^self genPushActiveContextBytecode].
+ }
+ otherwise:
+ [^self unknownBytecode].
+ ^0!
Item was added:
+ ----- Method: SimpleStackBasedCogit>>genReturnNilFromBlock (in category 'bytecode generators') -----
+ genReturnNilFromBlock
+ self assert: inBlock.
+ self flag: 'currently caller pushes result'.
+ self annotate: (self MoveCw: objectMemory nilObject R: ReceiverResultReg)
+ objRef: objectMemory nilObject.
+ ^self genBlockReturn!
Item was changed:
----- Method: SimpleStackBasedCogit>>genReturnTopFromBlock (in category 'bytecode generators') -----
genReturnTopFromBlock
self assert: inBlock.
self flag: 'currently caller pushes result'.
self PopR: ReceiverResultReg.
+ ^self genBlockReturn!
- needsFrame ifTrue:
- [self MoveR: FPReg R: SPReg.
- self PopR: FPReg].
- backEnd hasLinkRegister ifTrue:
- [self PopR: LinkReg].
- self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
- ^0!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>remember: (in category 'cog jit support') -----
+ remember: objOop
+ <doNotGenerate>
+ ^scavenger remember: objOop!
Item was changed:
----- Method: SpurMemoryManager>>fetchLong64:ofObject: (in category 'object access') -----
fetchLong64: longIndex ofObject: objOop
<returnTypeC: #sqLong>
+ ^self long64At: objOop + self baseHeaderSize + (longIndex << 3)!
- ^self long64At: objOop + self baseHeaderSize + (8 * (longIndex - 1))!
Item was changed:
----- Method: SpurMemoryManager>>fetchShort16:ofObject: (in category 'object access') -----
fetchShort16: shortIndex ofObject: objOop
+ ^self shortAt: objOop + self baseHeaderSize + (shortIndex << 1)!
- ^self shortAt: objOop + self baseHeaderSize + (2 * (shortIndex - 1))!
Item was changed:
----- Method: SpurMemoryManager>>storeLong64:ofObject:withValue: (in category 'object access') -----
storeLong64: longIndex ofObject: objOop withValue: value
<var: #value type: #sqLong>
+ ^self long64At: objOop + self baseHeaderSize + (longIndex << 3) put: value!
- ^self long64At: objOop + self baseHeaderSize + (8 * (longIndex - 1)) put: value!
Item was changed:
----- Method: SpurMemoryManager>>storeShort16:ofObject:withValue: (in category 'object access') -----
storeShort16: shortIndex ofObject: objOop withValue: value
+ ^self shortAt: objOop + self baseHeaderSize + (shortIndex << 1) put: value!
- ^self shortAt: objOop + self baseHeaderSize + (2 * (shortIndex - 1)) put: value!
Item was changed:
----- Method: StackInterpreter>>extPushPseudoVariable (in category 'stack bytecodes') -----
extPushPseudoVariable
+ "SistaV1: * 82 01010010 Push thisContext, (then e.g. Extend B 1 = push thisProcess)"
+ extB
- "SistaV1: * 82 01010010 Push thisContext, (then e.g. Extend 1 = push thisProcess)"
- extA
caseOf: {
[0] -> [self pushActiveContextBytecode].
[1] -> [self internalPush: self activeProcess] }
otherwise:
[self respondToUnknownBytecode].
self fetchNextBytecode.
+ extB := 0!
- extA := 0!
Item was changed:
SimpleStackBasedCogit subclass: #StackToRegisterMappingCogit
+ instanceVariableNames: 'prevBCDescriptor numPushNilsFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks debugBytecodePointers realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode'
- instanceVariableNames: 'prevBCDescriptor isPushNilFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks debugBytecodePointers realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode'
classVariableNames: ''
poolDictionaries: 'CogCompilationConstants VMMethodCacheConstants VMObjectIndices VMStackFrameOffsets'
category: 'VMMaker-JIT'!
StackToRegisterMappingCogit class
+ instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!
- instanceVariableNames: 'isPushNilFunction pushNilSizeFunction'!
!StackToRegisterMappingCogit commentStamp: 'eem 12/19/2010 18:12' prior: 0!
StackToRegisterMappingCogit is an optimizing code generator that eliminates a lot of stack operations and inlines some special selector arithmetic. It does so by a simple stack-to-register mapping scheme based on deferring the generation of code to produce operands until operand-consuming operations. The operations that consume operands are sends, stores and returns.
See methods in the class-side documentation protocol for more detail.
Instance Variables
callerSavedRegMask: <Integer>
ceEnter0ArgsPIC: <Integer>
ceEnter1ArgsPIC: <Integer>
ceEnter2ArgsPIC: <Integer>
ceEnterCogCodePopReceiverArg0Regs: <Integer>
ceEnterCogCodePopReceiverArg1Arg0Regs: <Integer>
debugBytecodePointers: <Set of Integer>
debugFixupBreaks: <Set of Integer>
debugStackPointers: <CArrayAccessor of (Integer|nil)>
methodAbortTrampolines: <CArrayAccessor of Integer>
methodOrBlockNumTemps: <Integer>
optStatus: <Integer>
picAbortTrampolines: <CArrayAccessor of Integer>
picMissTrampolines: <CArrayAccessor of Integer>
realCEEnterCogCodePopReceiverArg0Regs: <Integer>
realCEEnterCogCodePopReceiverArg1Arg0Regs: <Integer>
regArgsHaveBeenPushed: <Boolean>
simSelf: <CogSimStackEntry>
simSpillBase: <Integer>
simStack: <CArrayAccessor of CogSimStackEntry>
simStackPtr: <Integer>
traceSimStack: <Integer>
callerSavedRegMask
- the bitmask of the ABI's caller-saved registers
ceEnter0ArgsPIC ceEnter1ArgsPIC ceEnter2ArgsPIC
- the trampoline for entering an N-arg PIC
ceEnterCogCodePopReceiverArg0Regs ceEnterCogCodePopReceiverArg1Arg0Regs
- teh trampoline for entering a method with N register args
debugBytecodePointers
- a Set of bytecode pcs for setting breakpoints (simulation only)
debugFixupBreaks
- a Set of fixup indices for setting breakpoints (simulation only)
debugStackPointers
- an Array of stack depths for each bytecode for code verification
methodAbortTrampolines
- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
methodOrBlockNumTemps
- the number of method or block temps (including args) in the current compilation unit (method or block)
optStatus
- the variable used to track the status of ReceiverResultReg for avoiding reloading that register with self between adjacent inst var accesses
picAbortTrampolines
- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
picMissTrampolines
- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
realCEEnterCogCodePopReceiverArg0Regs realCEEnterCogCodePopReceiverArg1Arg0Regs
- the real trampolines for ebtering machine code with N reg args when in the Debug regime
regArgsHaveBeenPushed
- whether the register args have been pushed before frame build (e.g. when an interpreter primitive is called)
simSelf
- the simulation stack entry representing self in the current compilation unit
simSpillBase
- the variable tracking how much of the simulation stack has been spilled to the real stack
simStack
- the simulation stack itself
simStackPtr
- the pointer to the top of the simulation stack
!
StackToRegisterMappingCogit class
+ instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!
- instanceVariableNames: 'isPushNilFunction pushNilSizeFunction'!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCodeGen
aCodeGen
var: #methodAbortTrampolines
declareC: 'sqInt methodAbortTrampolines[4]';
var: #picAbortTrampolines
declareC: 'sqInt picAbortTrampolines[4]';
var: #picMissTrampolines
declareC: 'sqInt picMissTrampolines[4]';
var: 'ceCall0ArgsPIC'
declareC: 'void (*ceCall0ArgsPIC)(void)';
var: 'ceCall1ArgsPIC'
declareC: 'void (*ceCall1ArgsPIC)(void)';
var: 'ceCall2ArgsPIC'
declareC: 'void (*ceCall2ArgsPIC)(void)';
var: #ceCallCogCodePopReceiverArg0Regs
declareC: 'void (*ceCallCogCodePopReceiverArg0Regs)(void)';
var: #realCECallCogCodePopReceiverArg0Regs
declareC: 'void (*realCECallCogCodePopReceiverArg0Regs)(void)';
var: #ceCallCogCodePopReceiverArg1Arg0Regs
declareC: 'void (*ceCallCogCodePopReceiverArg1Arg0Regs)(void)';
var: #realCECallCogCodePopReceiverArg1Arg0Regs
declareC: 'void (*realCECallCogCodePopReceiverArg1Arg0Regs)(void)';
var: 'simStack'
declareC: 'CogSimStackEntry simStack[', ((CoInterpreter bindingOf: #LargeContextSize) value * 5 / 4 // BytesPerWord) asString, ']';
var: 'simSelf'
type: #CogSimStackEntry;
var: #optStatus
type: #CogSSOptStatus;
var: 'prevBCDescriptor'
type: #'BytecodeDescriptor *'.
+ self numPushNilsFunction ifNotNil:
- self isPushNilFunction ifNotNil:
[aCodeGen
+ var: 'numPushNilsFunction'
+ declareC: 'sqInt (* const numPushNilsFunction)(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self numPushNilsFunction);
- var: 'isPushNilFunction'
- declareC: 'sqInt (* const isPushNilFunction)(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self isPushNilFunction);
var: 'pushNilSizeFunction'
declareC: 'sqInt (* const pushNilSizeFunction)(sqInt) = ', (aCodeGen cFunctionNameFor: self pushNilSizeFunction)].
aCodeGen
addSelectorTranslation: #register to: (aCodeGen cFunctionNameFor: 'registerr');
addSelectorTranslation: #register: to: (aCodeGen cFunctionNameFor: 'registerr:')!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV3PlusClosures (in category 'class initialization') -----
initializeBytecodeTableForNewspeakV3PlusClosures
"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV3PlusClosures"
+ numPushNilsFunction := #v3:Num:Push:Nils:.
- isPushNilFunction := #v3:Is:Push:Nil:.
pushNilSizeFunction := #v3PushNilSize:.
NSSendIsPCAnnotated := true. "IsNSSendCall used by PushImplicitReceiver"
self flag:
'Special selector send class must be inlined to agree with the interpreter, which
inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
have identical semantics. We get away with not hardwiring the other special
selectors either because in the Cointerpreter they are not inlined or because they
are inlined only to instances of classes for which there will always be a method.'.
self generatorTableFrom: #(
(1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1)
(1 16 31 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
(1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
(1 64 95 genPushLiteralVariableBytecode needsFrameNever: 1)
(1 96 103 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
(1 104 111 genStoreAndPopTemporaryVariableBytecode)
(1 112 112 genPushReceiverBytecode needsFrameNever: 1)
(1 113 113 genPushConstantTrueBytecode needsFrameNever: 1)
(1 114 114 genPushConstantFalseBytecode needsFrameNever: 1)
(1 115 115 genPushConstantNilBytecode needsFrameNever: 1)
(1 116 119 genPushQuickIntegerConstantBytecode needsFrameNever: 1)
"method returns in blocks need a frame because of nonlocalReturn:through:"
(1 120 120 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
(1 121 121 genReturnTrue return needsFrameIfInBlock: isMappedInBlock 0)
(1 122 122 genReturnFalse return needsFrameIfInBlock: isMappedInBlock 0)
(1 123 123 genReturnNil return needsFrameIfInBlock: isMappedInBlock 0)
(1 124 124 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
(1 125 125 genReturnTopFromBlock return needsFrameNever: -1)
(3 126 126 genDynamicSuperSendBytecode isMapped) "Newspeak"
(2 127 127 genPushImplicitReceiverBytecode isMapped hasIRC) "Newspeak"
(2 128 128 extendedPushBytecode needsFrameNever: 1)
(2 129 129 extendedStoreBytecode)
(2 130 130 extendedStoreAndPopBytecode)
(2 131 131 genExtendedSendBytecode isMapped)
(3 132 132 doubleExtendedDoAnythingBytecode isMapped)
(2 133 133 genExtendedSuperBytecode isMapped)
(2 134 134 genSecondExtendedSendBytecode isMapped)
(1 135 135 genPopStackBytecode needsFrameNever: -1)
(1 136 136 duplicateTopBytecode needsFrameNever: 1)
(1 137 137 genPushActiveContextBytecode)
(2 138 138 genPushNewArrayBytecode)
(2 139 139 genPushExplicitOuterReceiverBytecode isMapped) "Newspeak"
(3 140 140 genPushRemoteTempLongBytecode)
(3 141 141 genStoreRemoteTempLongBytecode)
(3 142 142 genStoreAndPopRemoteTempLongBytecode)
(4 143 143 genPushClosureCopyCopiedValuesBytecode block v3:Block:Code:Size:)
(1 144 151 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
(1 152 159 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(2 160 163 genLongUnconditionalBackwardJump branch isMapped "because of interrupt check"
v3:Long:Branch:Distance:)
(2 164 167 genLongUnconditionalForwardJump branch v3:Long:Branch:Distance:)
(2 168 171 genLongJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
v3:LongForward:Branch:Distance:)
(2 172 175 genLongJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:LongForward:Branch:Distance:)
(1 176 176 genSpecialSelectorArithmetic isMapped AddRR)
(1 177 177 genSpecialSelectorArithmetic isMapped SubRR)
(1 178 178 genSpecialSelectorComparison isMapped JumpLess)
(1 179 179 genSpecialSelectorComparison isMapped JumpGreater)
(1 180 180 genSpecialSelectorComparison isMapped JumpLessOrEqual)
(1 181 181 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
(1 182 182 genSpecialSelectorComparison isMapped JumpZero)
(1 183 183 genSpecialSelectorComparison isMapped JumpNonZero)
(1 184 189 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //"
(1 190 190 genSpecialSelectorArithmetic isMapped AndRR)
(1 191 191 genSpecialSelectorArithmetic isMapped OrRR)
(1 192 197 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
(1 198 198 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
(1 199 199 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
(1 200 207 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
(1 208 223 genSendLiteralSelector0ArgsBytecode isMapped)
(1 224 239 genSendLiteralSelector1ArgBytecode isMapped)
(1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') -----
initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid
"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid"
super initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid.
+ numPushNilsFunction := #v3or4:Num:Push:Nils:.
- isPushNilFunction := #v3or4:Is:Push:Nil:.
pushNilSizeFunction := #v3or4PushNilSize:!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') -----
initializeBytecodeTableForNewspeakV4
"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV4"
+ numPushNilsFunction := #v4:Num:Push:Nils:.
- isPushNilFunction := #v4:Is:Push:Nil:.
pushNilSizeFunction := #v4PushNilSize:.
NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit"
self flag:
'Special selector send class must be inlined to agree with the interpreter, which
inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
have identical semantics. We get away with not hardwiring the other special
selectors either because in the Cointerpreter they are not inlined or because they
are inlined only to instances of classes for which there will always be a method.'.
self generatorTableFrom: #(
"1 byte bytecodes"
(1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1)
(1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
(1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
(1 64 75 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
(1 76 76 genPushReceiverBytecode needsFrameNever: 1)
(1 77 77 genExtPushPseudoVariableOrOuterBytecode)
(1 78 78 genPushConstantZeroBytecode needsFrameNever: 1)
(1 79 79 genPushConstantOneBytecode needsFrameNever: 1)
(1 80 80 genSpecialSelectorArithmetic isMapped AddRR)
(1 81 81 genSpecialSelectorArithmetic isMapped SubRR)
(1 82 82 genSpecialSelectorComparison isMapped JumpLess)
(1 83 83 genSpecialSelectorComparison isMapped JumpGreater)
(1 84 84 genSpecialSelectorComparison isMapped JumpLessOrEqual)
(1 85 85 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
(1 86 86 genSpecialSelectorComparison isMapped JumpZero)
(1 87 87 genSpecialSelectorComparison isMapped JumpNonZero)
(1 88 93 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //"
(1 94 94 genSpecialSelectorArithmetic isMapped AndRR)
(1 95 95 genSpecialSelectorArithmetic isMapped OrRR)
(1 96 101 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
(1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
(1 103 103 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
(1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
(1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
(1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
(1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
(1 160 175 genSendAbsentImplicit0ArgsBytecode isMapped hasIRC)
(1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
(1 184 191 genStoreAndPopTemporaryVariableBytecode)
(1 192 199 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
(1 200 207 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(1 208 215 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(1 216 216 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
(1 217 217 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
(1 218 218 genExtReturnTopFromBlock return needsFrameNever: -1)
(1 219 219 duplicateTopBytecode needsFrameNever: 1)
(1 220 220 genPopStackBytecode needsFrameNever: -1)
(1 221 221 genExtNopBytecode needsFrameNever: 0)
(1 222 223 unknownBytecode)
"2 byte bytecodes"
(2 224 224 extABytecode extension needsFrameNever: 0)
(2 225 225 extBBytecode extension needsFrameNever: 0)
(2 226 226 genExtPushReceiverVariableBytecode)
(2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1)
(2 228 228 genExtPushLiteralBytecode needsFrameNever: 1)
(2 229 229 genExtPushIntegerBytecode needsFrameNever: 1)
(2 230 230 genLongPushTemporaryVariableBytecode)
(2 231 231 genPushNewArrayBytecode)
(2 232 232 genExtStoreReceiverVariableBytecode)
(2 233 233 genExtStoreLiteralVariableBytecode)
(2 234 234 genLongStoreTemporaryVariableBytecode)
(2 235 235 genExtStoreAndPopReceiverVariableBytecode)
(2 236 236 genExtStoreAndPopLiteralVariableBytecode)
(2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
(2 238 238 genExtSendBytecode isMapped)
(2 239 239 genExtSendSuperBytecode isMapped)
(2 240 240 genExtSendAbsentImplicitBytecode isMapped hasIRC)
(2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped)
(2 242 242 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
(2 243 243 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
(2 244 244 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
(2 245 248 unknownBytecode)
"3 byte bytecodes"
(3 249 249 callPrimitiveBytecode)
(3 250 250 genPushRemoteTempLongBytecode)
(3 251 251 genStoreRemoteTempLongBytecode)
(3 252 252 genStoreAndPopRemoteTempLongBytecode)
(3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:)
(3 254 255 unknownBytecode))!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
initializeBytecodeTableForSistaV1
"StackToRegisterMappingCogit initializeBytecodeTableForSistaV1"
+ numPushNilsFunction := #sistaV1:Num:Push:Nils:.
- isPushNilFunction := #sistaV1:Is:Push:Nil:.
pushNilSizeFunction := #sistaV1PushNilSize:.
self flag:
'Special selector send class must be inlined to agree with the interpreter, which
inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
have identical semantics. We get away with not hardwiring the other special
selectors either because in the Cointerpreter they are not inlined or because they
are inlined only to instances of classes for which there will always be a method.'.
self generatorTableFrom: #(
"1 byte bytecodes"
"pushes"
(1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1)
(1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
(1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
(1 64 75 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
(1 76 76 genPushReceiverBytecode needsFrameNever: 1)
+ (1 77 77 genPushConstantTrueBytecode needsFrameNever: 1)
+ (1 78 78 genPushConstantFalseBytecode needsFrameNever: 1)
+ (1 79 79 genPushConstantNilBytecode needsFrameNever: 1)
- (1 77 77 pushConstantTrueBytecode needsFrameNever: 1)
- (1 78 78 pushConstantFalseBytecode needsFrameNever: 1)
- (1 79 79 pushConstantNilBytecode needsFrameNever: 1)
(1 80 80 genPushConstantZeroBytecode needsFrameNever: 1)
(1 81 81 genPushConstantOneBytecode needsFrameNever: 1)
(1 82 82 genExtPushPseudoVariable)
(1 83 83 duplicateTopBytecode needsFrameNever: 1)
(1 84 87 unknownBytecode)
"returns"
(1 88 88 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
(1 89 89 genReturnTrue return needsFrameIfInBlock: isMappedInBlock 0)
(1 90 90 genReturnFalse return needsFrameIfInBlock: isMappedInBlock 0)
(1 91 91 genReturnNil return needsFrameIfInBlock: isMappedInBlock 0)
(1 92 92 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
(1 93 93 genReturnNilFromBlock return needsFrameNever: -1)
(1 94 94 genReturnTopFromBlock return needsFrameNever: -1)
+ (1 95 95 genExtNopBytecode needsFrameNever: 0)
- (1 95 95 genExtNop needsFrameNever: 0)
"sends"
(1 96 96 genSpecialSelectorArithmetic isMapped AddRR)
(1 97 97 genSpecialSelectorArithmetic isMapped SubRR)
(1 98 98 genSpecialSelectorComparison isMapped JumpLess)
(1 99 99 genSpecialSelectorComparison isMapped JumpGreater)
(1 100 100 genSpecialSelectorComparison isMapped JumpLessOrEqual)
(1 101 101 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
(1 102 102 genSpecialSelectorComparison isMapped JumpZero)
(1 103 103 genSpecialSelectorComparison isMapped JumpNonZero)
(1 104 109 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //"
(1 110 110 genSpecialSelectorArithmetic isMapped AndRR)
(1 111 111 genSpecialSelectorArithmetic isMapped OrRR)
(1 112 117 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
(1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
(1 119 119 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
(1 120 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
(1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
(1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
(1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
"jumps"
(1 176 183 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
(1 184 191 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(1 192 199 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
"stores"
(1 200 207 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
(1 208 215 genStoreAndPopTemporaryVariableBytecode)
(1 216 216 genPopStackBytecode needsFrameNever: -1)
(1 217 223 unknownBytecode)
"2 byte bytecodes"
(2 224 224 extABytecode extension)
(2 225 225 extBBytecode extension)
"pushes"
(2 226 226 genExtPushReceiverVariableBytecode needsFrameNever: 1)
(2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1)
(2 228 228 genExtPushLiteralBytecode needsFrameNever: 1)
(2 229 229 genLongPushTemporaryVariableBytecode)
(2 230 230 genPushClosureTempsBytecode)
(2 231 231 genPushNewArrayBytecode)
(2 232 232 genExtPushIntegerBytecode needsFrameNever: 1)
(2 233 233 genExtPushCharacterBytecode needsFrameNever: 1)
"returns"
"sends"
(2 234 234 genExtSendBytecode isMapped)
(2 235 235 genExtSendSuperBytecode isMapped)
"sista bytecodes"
(2 236 236 genExtTrapIfNotInstanceOfBehaviorsBytecode isMapped)
"jumps"
(2 237 237 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
(2 238 238 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
(2 239 239 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
"stores"
(2 240 240 genExtStoreAndPopReceiverVariableBytecode)
(2 241 241 genExtStoreAndPopLiteralVariableBytecode)
(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
(2 243 243 genExtStoreReceiverVariableBytecode)
(2 244 244 genExtStoreLiteralVariableBytecode)
(2 245 245 genLongStoreTemporaryVariableBytecode)
(2 246 247 unknownBytecode)
"3 byte bytecodes"
(3 248 248 callPrimitiveBytecode)
(3 249 249 unknownBytecode) "reserved for Push Float"
+ (3 250 250 genExtPushClosureBytecode block v4:Block:Code:Size:)
- (3 250 250 genExtPushClosureBytecode block sistaV1:Block:Code:Size:)
(3 251 251 genPushRemoteTempLongBytecode)
(3 252 252 genStoreRemoteTempLongBytecode)
(3 253 253 genStoreAndPopRemoteTempLongBytecode)
(3 254 255 unknownBytecode))!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForSqueakV3PlusClosures (in category 'class initialization') -----
initializeBytecodeTableForSqueakV3PlusClosures
"StackToRegisterMappingCogit initializeBytecodeTableForSqueakV3PlusClosures"
+ numPushNilsFunction := #v3:Num:Push:Nils:.
- isPushNilFunction := #v3:Is:Push:Nil:.
pushNilSizeFunction := #v3PushNilSize:.
self flag:
'Special selector send class must be inlined to agree with the interpreter, which
inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
have identical semantics. We get away with not hardwiring the other special
selectors either because in the Cointerpreter they are not inlined or because they
are inlined only to instances of classes for which there will always be a method.'.
self generatorTableFrom: #(
(1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1)
(1 16 31 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
(1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
(1 64 95 genPushLiteralVariableBytecode needsFrameNever: 1)
(1 96 103 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
(1 104 111 genStoreAndPopTemporaryVariableBytecode)
(1 112 112 genPushReceiverBytecode needsFrameNever: 1)
(1 113 113 genPushConstantTrueBytecode needsFrameNever: 1)
(1 114 114 genPushConstantFalseBytecode needsFrameNever: 1)
(1 115 115 genPushConstantNilBytecode needsFrameNever: 1)
(1 116 119 genPushQuickIntegerConstantBytecode needsFrameNever: 1)
"method returns in blocks need a frame because of nonlocalReturn:through:"
(1 120 120 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
(1 121 121 genReturnTrue return needsFrameIfInBlock: isMappedInBlock 0)
(1 122 122 genReturnFalse return needsFrameIfInBlock: isMappedInBlock 0)
(1 123 123 genReturnNil return needsFrameIfInBlock: isMappedInBlock 0)
(1 124 124 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
(1 125 125 genReturnTopFromBlock return needsFrameNever: -1)
(1 126 127 unknownBytecode)
(2 128 128 extendedPushBytecode needsFrameNever: 1)
(2 129 129 extendedStoreBytecode)
(2 130 130 extendedStoreAndPopBytecode)
(2 131 131 genExtendedSendBytecode isMapped)
(3 132 132 doubleExtendedDoAnythingBytecode isMapped)
(2 133 133 genExtendedSuperBytecode isMapped)
(2 134 134 genSecondExtendedSendBytecode isMapped)
(1 135 135 genPopStackBytecode needsFrameNever: -1)
(1 136 136 duplicateTopBytecode needsFrameNever: 1)
(1 137 137 genPushActiveContextBytecode)
(2 138 138 genPushNewArrayBytecode)
(1 139 139 unknownBytecode)
(3 140 140 genPushRemoteTempLongBytecode)
(3 141 141 genStoreRemoteTempLongBytecode)
(3 142 142 genStoreAndPopRemoteTempLongBytecode)
(4 143 143 genPushClosureCopyCopiedValuesBytecode block v3:Block:Code:Size:)
(1 144 151 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
(1 152 159 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(2 160 163 genLongUnconditionalBackwardJump branch isMapped "because of interrupt check"
v3:Long:Branch:Distance:)
(2 164 167 genLongUnconditionalForwardJump branch v3:Long:Branch:Distance:)
(2 168 171 genLongJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
v3:LongForward:Branch:Distance:)
(2 172 175 genLongJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:LongForward:Branch:Distance:)
(1 176 176 genSpecialSelectorArithmetic isMapped AddRR)
(1 177 177 genSpecialSelectorArithmetic isMapped SubRR)
(1 178 178 genSpecialSelectorComparison isMapped JumpLess)
(1 179 179 genSpecialSelectorComparison isMapped JumpGreater)
(1 180 180 genSpecialSelectorComparison isMapped JumpLessOrEqual)
(1 181 181 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
(1 182 182 genSpecialSelectorComparison isMapped JumpZero)
(1 183 183 genSpecialSelectorComparison isMapped JumpNonZero)
(1 184 189 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //"
(1 190 190 genSpecialSelectorArithmetic isMapped AndRR)
(1 191 191 genSpecialSelectorArithmetic isMapped OrRR)
(1 192 197 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
(1 198 198 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
(1 199 199 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
(1 200 207 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
(1 208 223 genSendLiteralSelector0ArgsBytecode isMapped)
(1 224 239 genSendLiteralSelector1ArgBytecode isMapped)
(1 240 255 genSendLiteralSelector2ArgsBytecode isMapped))!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid (in category 'class initialization') -----
initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid
"StackToRegisterMappingCogit initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
super initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid.
+ numPushNilsFunction := #squeakV3orSistaV1:Num:Push:Nils:.
- isPushNilFunction := #squeakV3orSistaV1:Is:Push:Nil:.
pushNilSizeFunction := #squeakV3orSistaV1PushNilSize:!
Item was removed:
- ----- Method: StackToRegisterMappingCogit class>>isPushNilFunction (in category 'accessing') -----
- isPushNilFunction
- "Answer the value of isPushNilFunction"
-
- ^ isPushNilFunction!
Item was added:
+ ----- Method: StackToRegisterMappingCogit class>>numPushNilsFunction (in category 'accessing') -----
+ numPushNilsFunction
+ "Answer the value of numPushNilsFunction"
+
+ ^numPushNilsFunction!
Item was changed:
----- Method: StackToRegisterMappingCogit class>>requiredMethodNames: (in category 'translation') -----
requiredMethodNames: options
^(super requiredMethodNames: options)
+ add: self numPushNilsFunction;
- add: self isPushNilFunction;
add: self pushNilSizeFunction;
yourself!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genReturnTopFromBlock (in category 'bytecode generators') -----
genReturnTopFromBlock
self assert: inBlock.
self ssTop popToReg: ReceiverResultReg.
self ssPop: 1.
+ ^self genBlockReturn!
- needsFrame ifTrue:
- [self MoveR: FPReg R: SPReg.
- self PopR: FPReg].
- backEnd hasLinkRegister ifTrue:
- [self PopR: LinkReg].
- self RetN: methodOrBlockNumArgs + 1 * BytesPerWord.
- ^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>isPushNil:pc:nExts:method: (in category 'span functions') -----
isPushNil: descriptor pc: pc nExts: nExts method: aMethodObj
<inline: true>
<var: #descriptor type: #'BytecodeDescriptor *'>
+ ^self perform: numPushNilsFunction
- ^self perform: isPushNilFunction
with: descriptor
with: pc
with: nExts
with: aMethodObj!
Item was added:
+ ----- Method: StackToRegisterMappingCogit>>numPushNils:pc:nExts:method: (in category 'span functions') -----
+ numPushNils: descriptor pc: pc nExts: nExts method: aMethodObj
+ <inline: true>
+ <var: #descriptor type: #'BytecodeDescriptor *'>
+ ^self perform: numPushNilsFunction
+ with: descriptor
+ with: pc
+ with: nExts
+ with: aMethodObj!
Item was changed:
----- Method: StackToRegisterMappingCogit>>scanBlock: (in category 'compile abstract instructions') -----
scanBlock: blockStart
"Scan the block to determine if the block needs a frame or not"
+ | descriptor pc end framelessStackDelta nExts pushingNils numPushNils |
- | descriptor pc end framelessStackDelta nExts pushingNils |
<var: #blockStart type: #'BlockStart *'>
<var: #descriptor type: #'BytecodeDescriptor *'>
needsFrame := false.
prevBCDescriptor := nil.
methodOrBlockNumArgs := blockStart numArgs.
inBlock := true.
pc := blockStart startpc.
end := blockStart startpc + blockStart span.
framelessStackDelta := nExts := 0.
pushingNils := true.
[pc < end] whileTrue:
[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
descriptor := self generatorAt: byte0.
needsFrame ifFalse:
[(descriptor needsFrameFunction isNil
or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
ifTrue: [needsFrame := true]
ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
(pushingNils
and: [descriptor isExtension not]) ifTrue:
["Count the initial number of pushed nils acting as temp initializers. We can't tell
whether an initial pushNil is an operand reference or a temp initializer, except
+ when the pushNil is a jump target (has a fixup), which never happens:
+ self systemNavigation browseAllSelect:
+ [:m| | ebc |
+ (ebc := m embeddedBlockClosures
+ select: [:ea| ea decompile statements first isMessage]
+ thenCollect: [:ea| ea decompile statements first selector]) notEmpty
+ and: [(#(whileTrue whileFalse whileTrue: whileFalse:) intersection: ebc) notEmpty]]
+ or if the bytecode set has a push multiple nils bytecode. We simply count initial nils.
+ Rarely we may end up over-estimating. We will correct by checking the stack depth
+ at the end of the block in compileBlockBodies."
+ (numPushNils := self numPushNils: descriptor pc: pc nExts: nExts method: methodObj) > 0
+ ifTrue:
+ [self assert: descriptor numBytes = 1. "see compileMethodBody"
+ blockStart numInitialNils: blockStart numInitialNils + numPushNils]
+ ifFalse:
+ [pushingNils := false]].
- when the pushNil is a jump target (has a fixup) in which case it is definitely an
- operand reference. So rarely we may end up over-estimating. We will correct
- by checking the stack depth at the end of the block in compileBlockBodies."
- (pushingNils := (self isPushNil: descriptor pc: pc nExts: nExts method: methodObj)
- and: [(self fixupAt: pc - initialPC) targetInstruction = 0]) ifTrue:
- [self assert: descriptor numBytes = 1. "see compileMethodBody"
- blockStart numInitialNils: blockStart numInitialNils + 1]].
pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
prevBCDescriptor := descriptor].
"It would be nice of this wasn't necessary but alas we need to do the eager
scan for frameless methods so that we don't end up popping too much off
the simulated stack, e.g. for pushNil; returnTopFromBlock methods."
needsFrame ifFalse:
[self assert: (framelessStackDelta >= 0 and: [blockStart numInitialNils >= framelessStackDelta]).
blockStart numInitialNils: blockStart numInitialNils - framelessStackDelta]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>setInterpreter: (in category 'initialization') -----
setInterpreter: aCoInterpreter
"Initialization of the code generator in the simulator.
These objects already exist in the generated C VM
or are used only in the simulation."
<doNotGenerate>
super setInterpreter: aCoInterpreter.
methodAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
picAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
picMissTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
simStack := CArrayAccessor on: ((1 to: 256) collect: [:i| CogSimStackEntry new cogit: self]).
simSelf := CogSimStackEntry new cogit: self.
optStatus := CogSSOptStatus new.
debugFixupBreaks := Set new.
debugBytecodePointers := Set new.
+ numPushNilsFunction := self class numPushNilsFunction.
+ pushNilSizeFunction := self class pushNilSizeFunction!
- isPushNilFunction := self class isPushNilFunction.
- pushNilSizeFunction := self class pushNilSizeFunction.!
Item was added:
+ ----- Method: StackToRegisterMappingCogit>>sistaV1:Num:Push:Nils: (in category 'span functions') -----
+ sistaV1: descriptor Num: pc Push: nExts Nils: aMethodObj
+ "230 11100110 iiiiiiii PushNClosureTemps iiiiiiii"
+ <var: #descriptor type: #'BytecodeDescriptor *'>
+ <inline: true>
+ ^descriptor generator == #genPushClosureTempsBytecode
+ ifTrue: [objectMemory fetchByte: pc + 1 ofObject: aMethodObj]
+ ifFalse: [0]!
Item was added:
+ ----- Method: StackToRegisterMappingCogit>>squeakV3orSistaV1:Num:Push:Nils: (in category 'span functions') -----
+ squeakV3orSistaV1: descriptor Num: pc Push: nExts Nils: aMethodObj
+ <var: #descriptor type: #'BytecodeDescriptor *'>
+ | numNils |
+ (numNils := self v3: descriptor Num: pc Push: nExts Nils: aMethodObj) > 0 ifTrue:
+ [^numNils].
+ ^self sistaV1: descriptor Num: pc Push: nExts Nils: aMethodObj!
Item was removed:
- ----- Method: StackToRegisterMappingCogit>>v3:Is:Push:Nil: (in category 'span functions') -----
- v3: descriptor Is: pc Push: nExts Nil: aMethodObj
- <var: #descriptor type: #'BytecodeDescriptor *'>
- <inline: true>
- ^descriptor generator == #genPushConstantNilBytecode!
Item was added:
+ ----- Method: StackToRegisterMappingCogit>>v3:Num:Push:Nils: (in category 'span functions') -----
+ v3: descriptor Num: pc Push: nExts Nils: aMethodObj
+ <var: #descriptor type: #'BytecodeDescriptor *'>
+ <inline: true>
+ ^descriptor generator == #genPushConstantNilBytecode
+ ifTrue: [1]
+ ifFalse: [0]!
Item was removed:
- ----- Method: StackToRegisterMappingCogit>>v3or4:Is:Push:Nil: (in category 'span functions') -----
- v3or4: descriptor Is: pc Push: nExts Nil: aMethodObj
- <var: #descriptor type: #'BytecodeDescriptor *'>
- ^(self v3: descriptor Is: pc Push: nExts Nil: aMethodObj)
- or: [self v4: descriptor Is: pc Push: nExts Nil: aMethodObj]!
Item was added:
+ ----- Method: StackToRegisterMappingCogit>>v3or4:Num:Push:Nils: (in category 'span functions') -----
+ v3or4: descriptor Num: pc Push: nExts Nils: aMethodObj
+ <var: #descriptor type: #'BytecodeDescriptor *'>
+ | numNils |
+ (numNils := self v3: descriptor Num: pc Push: nExts Nils: aMethodObj) > 0 ifTrue:
+ [^numNils].
+ ^self v4: descriptor Num: pc Push: nExts Nils: aMethodObj!
Item was removed:
- ----- Method: StackToRegisterMappingCogit>>v4:Is:Push:Nil: (in category 'span functions') -----
- v4: descriptor Is: pc Push: nExts Nil: aMethodObj
- <var: #descriptor type: #'BytecodeDescriptor *'>
- <inline: true>
- ^descriptor generator == #genExtPushPseudoVariableOrOuterBytecode
- and: [self assert: (objectMemory fetchByte: pc ofObject: aMethodObj) = 77.
- nExts = 1
- and: [(objectMemory fetchByte: pc - 1 ofObject: aMethodObj) = 2]]!
Item was added:
+ ----- Method: StackToRegisterMappingCogit>>v4:Num:Push:Nils: (in category 'span functions') -----
+ v4: descriptor Num: pc Push: nExts Nils: aMethodObj
+ "* 77 01001101 Push false [* 1:true, 2:nil, 3:thisContext, ..., -N: pushExplicitOuter: N, N = Extend B]"
+ <var: #descriptor type: #'BytecodeDescriptor *'>
+ <inline: true>
+ ^(descriptor generator == #genExtPushPseudoVariableOrOuterBytecode
+ and: [self assert: (objectMemory fetchByte: pc ofObject: aMethodObj) = 77.
+ nExts = 1
+ and: [(objectMemory fetchByte: pc - 1 ofObject: aMethodObj) = 2]])
+ ifTrue: [1]
+ ifFalse: [0]!
1
0
Esteban Lorenzano uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog.pharo-EstebanLorenzano.175.mcz
==================== Summary ====================
Name: Cog.pharo-EstebanLorenzano.175
Author: EstebanLorenzano
Time: 29 July 2014, 12:12:39.440319 pm
UUID: fe465b03-0277-4bc6-9b98-3af92cf63eb5
Ancestors: Cog-EstebanLorenzano.174
new merge with Eliot's
=============== Diff against Cog-eem.173 ===============
Item was changed:
+ SystemOrganization addCategory: #Cog!
+ SystemOrganization addCategory: 'Cog-Benchmarks-DeltaBlue'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-Richards'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-SMark'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-Shootout'!
+ SystemOrganization addCategory: 'Cog-Bootstrapping'!
+ SystemOrganization addCategory: 'Cog-Morphing Bytecode Set'!
+ SystemOrganization addCategory: 'Cog-ProcessorPlugins'!
+ SystemOrganization addCategory: 'Cog-Processors'!
+ SystemOrganization addCategory: 'Cog-Processors-Tests'!
+ SystemOrganization addCategory: 'Cog-Scripting'!
+ SystemOrganization addCategory: 'Cog-Scripts'!
+ SystemOrganization addCategory: 'Cog-Tests'!
- SystemOrganization addCategory: #'Cog-Benchmarks-DeltaBlue'!
- SystemOrganization addCategory: #'Cog-Benchmarks-Richards'!
- SystemOrganization addCategory: #'Cog-Benchmarks-SMark'!
- SystemOrganization addCategory: #'Cog-Benchmarks-Shootout'!
- SystemOrganization addCategory: #'Cog-Bootstrapping'!
- SystemOrganization addCategory: #'Cog-Morphing Bytecode Set'!
- SystemOrganization addCategory: #'Cog-ProcessorPlugins'!
- SystemOrganization addCategory: #'Cog-Processors'!
- SystemOrganization addCategory: #'Cog-Processors-Tests'!
- SystemOrganization addCategory: #'Cog-Scripting'!
- SystemOrganization addCategory: #'Cog-Scripts'!
- SystemOrganization addCategory: #'Cog-Tests'!
Item was changed:
+ ----- Method: SpurBootstrap class>>CharacterPROTOTYPEclone (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
CharacterPROTOTYPEclone
"Answer the receiver, because Characters are unique."
^self!
Item was added:
+ ----- Method: SpurBootstrap class>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
+ CharacterPROTOTYPEsetValue: newValue
+ self error: 'Characters are immutable'!
Item was changed:
+ ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes pharo') -----
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
CharacterPROTOTYPEshallowCopy
"Answer the receiver, because Characters are unique."
^self!
Item was changed:
+ ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes squeak') -----
ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
"Compute the new format for making oldClass a subclass of newSuper.
Answer the format or nil if there is any problem."
| instSize isVar isWords isPointers isWeak |
type == #compiledMethod ifTrue:
[newInstSize > 0 ifTrue:
[self error: 'A compiled method class cannot have named instance variables'.
^nil].
^CompiledMethod format].
instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
instSize > 65535 ifTrue:
[self error: 'Class has too many instance variables (', instSize printString,')'.
^nil].
type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
(isPointers not and: [instSize > 0]) ifTrue:
[self error: 'A non-pointer class cannot have named instance variables'.
^nil].
^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
Item was changed:
+ ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes squeak') -----
ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
"Compute the format for the given instance specfication.
Above Cog Spur the class format is
<5 bits inst spec><16 bits inst size>
where the 5-bit inst spec is
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 = unused
7 = immediates (SmallInteger, Character)
8 = unused
9 = reserved for 64-bit indexable
10-11 = 32-bit indexable (Bitmap)
12-15 = 16-bit indexable
16-23 = 8-bit indexable
24-31 = compiled methods (CompiledMethod)"
| instSpec |
instSpec := isWeak
ifTrue:
[isVar
ifTrue: [4]
ifFalse: [5]]
ifFalse:
[isPointers
ifTrue:
[isVar
ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
ifFalse:
[isVar
ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
ifFalse: [7]]].
^(instSpec bitShift: 16) + nInstVars!
Item was changed:
+ ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes squeak') -----
ClassBuilderPROTOTYPEsuperclass: aClass
immediateSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a
new immediate class as a subclass of an existing class."
| env |
aClass instSize > 0
ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
aClass isVariable
ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
aClass isPointers
ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
"Cope with pre-environment and environment versions. Simplify asap."
env := (Smalltalk classNamed: #EnvironmentRequest)
ifNil: [aClass environment]
ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
^self
name: t
inEnvironment: env
subclassOf: aClass
type: #immediate
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!
Item was changed:
+ ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes squeak') -----
ClassBuilderPROTOTYPEupdate: oldClass to: newClass
"Convert oldClass, all its instances and possibly its meta class into newClass,
instances of newClass and possibly its meta class. The process is surprisingly
simple in its implementation and surprisingly complex in its nuances and potentially
bad side effects.
We can rely on two assumptions (which are critical):
#1: The method #updateInstancesFrom: will not create any lasting pointers to
'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
a become of the old vs. the new instances and therefore it will not create
pointers to *new* instances before the #become: which are *old* afterwards)
#2: The non-preemptive execution of the critical piece of code guarantees that
nobody can get a hold by 'other means' (such as process interruption and
reflection) on the old instances.
Given the above two, we know that after #updateInstancesFrom: there are no pointers
to any old instances. After the forwarding become there will be no pointers to the old
class or meta class either.
Andreas Raab, 2/27/2003 23:42"
| meta |
meta := oldClass isMeta.
"Note: Everything from here on will run without the ability to get interrupted
to prevent any other process to create new instances of the old class."
["Note: The following removal may look somewhat obscure and needs an explanation.
When we mutate the class hierarchy we create new classes for any existing subclass.
So it may look as if we don't have to remove the old class from its superclass. However,
at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
subclasses. Since the #become: below will transparently replace the pointers to oldClass
with newClass the superclass would have newClass in its subclasses TWICE. With rather
unclear effects if we consider that we may convert the meta-class hierarchy itself (which
is derived from the non-meta class hierarchy).
Due to this problem ALL classes are removed from their superclass just prior to converting
them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
effectively remove the oldClass (becomeForward:) just a few lines below."
oldClass superclass removeSubclass: oldClass.
oldClass superclass removeObsoleteSubclass: oldClass.
"make sure that the VM cache is clean"
oldClass methodDict do: [:cm | cm flushCache].
"Convert the instances of oldClass into instances of newClass"
newClass updateInstancesFrom: oldClass.
meta
ifTrue:
[oldClass becomeForward: newClass.
oldClass updateMethodBindingsTo: oldClass binding]
ifFalse:
[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
oldClass updateMethodBindingsTo: oldClass binding.
oldClass class updateMethodBindingsTo: oldClass class binding].
"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
to ensure no old instances existed after the becomeForward:. Without the GC it was possible
to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
updated references from the old objects to new objects but didn't destroy the old objects.
But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
valueUnpreemptively!
Item was changed:
+ ----- Method: SpurBootstrap class>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
IntegerclassPROTOTYPEinitialize
"Integer initialize"
self initializeLowBitPerByteTable!
Item was changed:
----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
"Smalltalk recreateSpecialObjectsArray"
"To external package developers:
**** DO NOT OVERRIDE THIS METHOD. *****
If you are writing a plugin and need additional special object(s) for your own use,
use addGCRoot() function and use own, separate special objects registry "
"The Special Objects Array is an array of objects used by the Squeak virtual machine.
Its contents are critical and accesses to it by the VM are unchecked, so don't even
think of playing here unless you know what you are doing."
| newArray |
newArray := Array new: 60.
"Nil false and true get used throughout the interpreter"
newArray at: 1 put: nil.
newArray at: 2 put: false.
newArray at: 3 put: true.
"This association holds the active process (a ProcessScheduler)"
newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
"Numerous classes below used for type checking and instantiation"
newArray at: 5 put: Bitmap.
newArray at: 6 put: SmallInteger.
newArray at: 7 put: ByteString.
newArray at: 8 put: Array.
newArray at: 9 put: Smalltalk.
newArray at: 10 put: Float.
+ newArray at: 11 put: (self globals at: #Context).
+ newArray at: 12 put: nil. "was BlockContext."
- newArray at: 11 put: MethodContext.
- newArray at: 12 put: BlockContext.
newArray at: 13 put: Point.
newArray at: 14 put: LargePositiveInteger.
newArray at: 15 put: Display.
newArray at: 16 put: Message.
newArray at: 17 put: CompiledMethod.
+ newArray at: 18 put: (self specialObjectsArray
+ ifNotNil: [ self specialObjectsArray at: 18 ]
+ ifNil: [ Semaphore new ]). "(low space Semaphore)"
- newArray at: 18 put: (self specialObjectsArray at: 18). "(low space Semaphore)"
newArray at: 19 put: Semaphore.
newArray at: 20 put: Character.
newArray at: 21 put: #doesNotUnderstand:.
newArray at: 22 put: #cannotReturn:.
newArray at: 23 put: nil. "This is the process signalling low space."
"An array of the 32 selectors that are compiled as special bytecodes,
paired alternately with the number of arguments each takes."
newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
#* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
#at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
#blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
"An array of the 255 Characters in ascii order.
Cog inlines table into machine code at: prim so do not regenerate it.
This is nil in Spur, which has immediate Characters."
newArray at: 25 put: (self specialObjectsArray at: 25).
newArray at: 26 put: #mustBeBoolean.
newArray at: 27 put: ByteArray.
newArray at: 28 put: Process.
"An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
newArray at: 29 put: self compactClassesArray.
+ newArray at: 30 put: (self specialObjectsArray
+ ifNotNil: [ self specialObjectsArray at: 30 ]
+ ifNil: [ Semaphore new ]). "(delay Semaphore)"
+ newArray at: 31 put: (self specialObjectsArray
+ ifNotNil: [ self specialObjectsArray at: 31 ]
+ ifNil: [ Semaphore new ]). "(user interrupt Semaphore)"
- newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)"
- newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)"
"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
newArray at: 32 put: nil. "was the prototype Float"
newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
newArray at: 34 put: nil. "was the prototype Point"
newArray at: 35 put: #cannotInterpret:.
newArray at: 36 put: nil. "was the prototype MethodContext"
newArray at: 37 put: BlockClosure.
newArray at: 38 put: nil. "was the prototype BlockContext"
"array of objects referred to by external code"
newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
newArray at: 41 put: ((self specialObjectsArray at: 39) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ newArray at: 42 put: (self specialObjectsArray
+ ifNotNil: [ (self specialObjectsArray at: 42) ifNil: [ Semaphore new ] ]
+ ifNil: [ Semaphore new ]).
- newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
newArray at: 43 put: LargeNegativeInteger.
"External objects for callout.
Note: Written so that one can actually completely remove the FFI."
newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
newArray at: 49 put: #aboutToReturn:through:.
newArray at: 50 put: #run:with:in:.
"51 reserved for immutability message"
newArray at: 51 put: #attemptToAssign:withIndex:.
newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
#'bad argument' #'bad index'
#'bad number of arguments'
#'inappropriate operation' #'unsupported operation'
#'no modification' #'insufficient object memory'
#'insufficient C memory' #'not found' #'bad method'
#'internal error in named primitive machinery'
#'object may move' #'resource limit exceeded'
#'object is pinned' #'primitive write beyond end of object').
"53 to 55 are for Alien"
newArray at: 53 put: (self at: #Alien ifAbsent: []).
newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
"Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
newArray at: 56 put: nil.
"reserved for foreign callback process"
newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
newArray at: 58 put: #unusedBytecode.
"59 reserved for Sista counter tripped message"
newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
"60 reserved for Sista class trap message"
newArray at: 60 put: #classTrapFor:.
"Now replace the interpreter's reference in one atomic operation"
self specialObjectsArray becomeForward: newArray!
Item was changed:
----- Method: SpurBootstrap>>addNewMethods (in category 'bootstrap methods') -----
addNewMethods
"Get the simulator to add any and all missing methods immediately."
| cmaiaSym basSym |
cmaiaSym := self findSymbol: #compiledMethodAt:ifAbsent:.
basSym := self findSymbol: #basicAddSelector:withMethod:.
basSym ifNil:
[basSym := self findSymbol: #addSelectorSilently:withMethod:].
self allPrototypeClassNamesDo:
[:sym :symIsMeta| | class |
class := self findClassNamed: (literalMap at: sym).
symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
self prototypeClassNameMetaSelectorMethodDo:
[:className :isMeta :selector :method| | methodOrNil |
(className = sym
and: [symIsMeta = isMeta]) ifTrue:
["probe method dictionary of the class for each method, installing a dummy if not found."
"Transcript cr; nextPutAll: 'checking for '; nextPutAll: selector; flush."
methodOrNil := self interpreter: oldInterpreter
object: class
perform: cmaiaSym
withArguments: {literalMap at: selector. oldHeap nilObject}.
methodOrNil = oldHeap nilObject
ifTrue: "no method. install the real thing now"
[Transcript
cr;
nextPutAll: 'installing ';
nextPutAll: className;
nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
+ nextPutAll: selector printString;
- store: selector;
flush.
self interpreter: oldInterpreter
object: class
perform: basSym
withArguments: { literalMap at: selector.
self installableMethodFor: method
selector: selector
className: className
isMeta: isMeta}.
installedPrototypes add: method selector]
ifFalse: "existing method; collect the methodClassAssociation; its needed later"
[methodClasses add: (oldInterpreter methodClassAssociationOf: methodOrNil)]]]]!
Item was changed:
----- Method: SpurBootstrap>>bootstrapImageUsingFileReference: (in category 'public access') -----
bootstrapImageUsingFileReference: imageName
| dirName baseName dir |
dirName := imageName asFileReference parent fullName.
baseName := (imageName endsWith: '.image')
ifTrue: [ imageName asFileReference base ]
ifFalse: [ (imageName, '.image') asFileReference base ].
dir := dirName asFileReference.
self on: (dir / (baseName, '.image')) fullName.
[self transform]
on: Halt
do: [:ex|
"suppress halts from the usual suspects (development time halts)"
(#(fullGC compactImage) includes: ex signalerContext sender selector)
ifTrue: [ex resume]
ifFalse: [ex pass]].
self writeSnapshot: (dir / (baseName, '-spur.image')) fullName
ofTransformedImage: newHeap
headerFlags: oldInterpreter getImageHeaderFlags
screenSize: oldInterpreter savedWindowSize.
(dir / (baseName, '.changes')) copyTo: (dir / (baseName, '-spur.changes'))!
Item was changed:
----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
findRequiredGlobals
"Look for the necessary gobal bindings in the prototype methods in the old image.
This has to be done early by sending bindingOf: to Smalltalk. Also find out
Metaclass, needed for identofying classes."
| globals bindingOf |
globals := Set new.
self prototypeClassNameMetaSelectorMethodDo:
[:c :m :s :method|
globals addAll: (method literals select: [:l|
l isVariableBinding
and: [l key isSymbol
and: [(Smalltalk bindingOf: l key) == l]]])].
bindingOf := self findSymbol: #bindingOf:.
self withExecutableInterpreter: oldInterpreter
+ do: [globals asArray withIndexDo:
+ [:global :index|
- do: [globals do:
- [:global|
literalMap
at: global
put: (self interpreter: oldInterpreter
object: (oldHeap splObj: 8) "Smalltalk"
perform: bindingOf
withArguments: {self findSymbol: global key})]].
classMetaclass := oldHeap fetchClassOfNonImm: (oldHeap fetchClassOfNonImm: oldHeap classArray)!
Item was changed:
----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
rehashImage
"Rehash all collections in newHeap.
Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
| n sim rehashFlags |
sim := StackInterpreterSimulator onObjectMemory: newHeap.
+ sim
+ setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags;
+ imageName: 'spur image'.
- sim imageName: 'spur image'.
newHeap coInterpreter: sim.
sim bootstrapping: true.
sim initializeInterpreter: 0.
sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
newHeap
setHashBitsOf: newHeap nilObject to: 1;
setHashBitsOf: newHeap falseObject to: 2;
setHashBitsOf: newHeap trueObject to: 3.
rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize.
n := 0.
newHeap classTableObjectsDo:
[:class| | classIndex |
sim messageSelector: (map at: rehashSym).
"Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
((sim lookupMethodNoMNUEtcInClass: class) = 0
and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
[n := n + 1.
classIndex := newHeap rawHashBitsOf: class.
rehashFlags
at: classIndex >> 3 + 1
put: ((rehashFlags at: classIndex >> 3 + 1)
bitOr: (1 << (classIndex bitAnd: 7)))]].
Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
n := 0.
self withExecutableInterpreter: sim
do: [sim setBreakSelector: 'error:'.
"don't rehash twice (actually without limit), so don't rehash any new objects created."
newHeap allExistingOldSpaceObjectsDo:
[:o| | classIndex |
classIndex := newHeap classIndexOf: o.
((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
[(n := n + 1) \\ 8 = 0 ifTrue:
[Transcript nextPut: $.; flush].
"2845 = n ifTrue: [self halt]."
"Rehash an object if its size is > 0.
Symbol implements rehash, but let's not waste time rehashing it; in Squeak
up to 2013 symbols are kept in a set which will get reashed anyway..
Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
((sim addressCouldBeClassObj: o)
or: [(self interpreter: sim
object: o
perform: (map at: sizeSym)
withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse:
[self interpreter: sim
object: o
perform: (map at: rehashSym)
withArguments: #()]]]]!
Item was changed:
----- Method: SpurBootstrap>>replaceMethods (in category 'bootstrap methods') -----
replaceMethods
"Replace all the modified method prototypes."
self allPrototypeClassNamesDo:
[:sym :symIsMeta| | class |
class := self findClassNamed: (literalMap at: sym).
symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
self prototypeClassNameMetaSelectorMethodDo:
[:className :isMeta :selector :method| | replacement methodDict index |
(className = sym
and: [symIsMeta = isMeta]) ifTrue:
[(installedPrototypes includes: method selector) ifFalse:
["probe method dictionary of the class for each method, installing a dummy if not found."
Transcript
cr;
nextPutAll: 'replacing ';
nextPutAll: className;
nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
+ nextPutAll: selector printString;
- store: selector;
flush.
replacement := self installableMethodFor: method
selector: selector
className: className
isMeta: isMeta.
methodDict := oldHeap fetchPointer: MethodDictionaryIndex ofObject: class.
index := self indexOfSelector: (literalMap at: selector) in: methodDict.
oldHeap
storePointer: index - SelectorStart
ofObject: (oldHeap fetchPointer: MethodArrayIndex ofObject: methodDict)
withValue: replacement.
installedPrototypes add: method selector]]]]!
Item was changed:
----- Method: SpurBootstrap>>withExecutableInterpreter:do: (in category 'bootstrap methods') -----
withExecutableInterpreter: sim do: aBlock
"With the oldInterpreter ready to execute code, evaluate aBlock,
then return the interpreter (and the heap) to the ``just snapshotted'' state."
| savedpc initialContext finalContext |
sim
initStackPages;
loadInitialContext;
internalizeIPandSP.
initialContext := sim frameContext: sim localFP.
savedpc := sim localIP.
"sim printHeadFrame."
aBlock value.
"sim printHeadFrame."
sim
internalPush: sim localIP;
externalizeIPandSP.
"now undo the execution state"
finalContext := sim voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
self assert: initialContext = finalContext.
self assert: sim localIP = savedpc.
sim objectMemory
storePointer: SuspendedContextIndex
ofObject: sim activeProcess
withValue: finalContext!
1
0
Eliot Miranda uploaded a new version of BytecodeSets to project VM Maker:
http://source.squeak.org/VMMaker/BytecodeSets-eem.6.mcz
==================== Summary ====================
Name: BytecodeSets-eem.6
Author: eem
Time: 28 July 2014, 8:52:49.245 pm
UUID: 720d4320-af8e-4389-b22c-c4249d29f4ea
Ancestors: BytecodeSets-eem.5
Use extB for extPushPseudoVariable to match NewsqueakV4
=============== Diff against BytecodeSets-eem.5 ===============
Item was changed:
BytecodeEncoder subclass: #EncoderForSistaV1
(excessive size, no diff calculated)
Item was changed:
----- Method: EncoderForSistaV1>>genPushThisContext (in category 'bytecode generation') -----
genPushThisContext
+ "82 01010010 Push thisContext, (then e.g. Extend B 1 = push thisProcess)"
- "82 01010010 Push thisContext, (then e.g. Extend 1 = push thisProcess)"
stream nextPut: 82!
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.837.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.837
Author: eem
Time: 28 July 2014, 7:24:22.923 pm
UUID: e32a7e76-4a4d-48ae-adf6-28d22f64b157
Ancestors: VMMaker.oscog-eem.836
Sista:
Provide a SistaVM flag for <option: SistaVM> pragmas.
Implement the inlined ops in callPrimitiveMethod for the
current Sista spec in StackInterpreter.
Implement the SistaV1 bytecode table for
StackToRegisterMappingCogit
All:
Rationalize the length functions, deleting byteLengthOf:,
fetchLong32LengthOf: & fetchWordLengthOf: and providing
numBytesOf:, num16BitUnitsOf:, num32BitUnitsOf:,
num64BitUnitsOf: and numBytesOf:.
Provide fetch/storeShort16:ofObject:[withValue:] and
fetch/storeLong64:ofObject:[withValue:].
Recategorize ObjectMemory methods categorized as
object access in SpurMemoryManager as object access.
Spur: provide unpinObject: for InterpreterProxy.
=============== Diff against VMMaker.oscog-eem.836 ===============
Item was changed:
----- Method: CoInterpreter>>assertValidExecutionPointe:r:s:imbar:line: (in category 'debug support') -----
assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterpreter line: ln
<var: #lip type: #usqInt>
<var: #lifp type: #'char *'>
<var: #lisp type: #'char *'>
| methodField cogMethod theIP |
<var: #cogMethod type: #'CogMethod *'>
self assert: stackPage = (stackPages stackPageFor: lifp) l: ln.
self assert: stackPage = stackPages mostRecentlyUsedPage l: ln.
self assert: (self deferStackLimitSmashAround: #assertValidStackLimits: asSymbol with: ln).
self assert: lifp < stackPage baseAddress l: ln.
self assert: lisp < lifp l: ln.
self assert: lifp > lisp l: ln.
self assert: lisp >= (stackPage realStackLimit - self stackLimitOffset) l: ln.
self assert: (lifp - lisp) < LargeContextSize l: ln.
methodField := self frameMethodField: lifp.
inInterpreter
ifTrue:
[self assert: (self isMachineCodeFrame: lifp) not l: ln.
self assert: method = methodField l: ln.
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256) l: ln].
(self asserta: (objectMemory cheapAddressCouldBeInHeap: methodField) l: ln) ifTrue:
[theIP := lip = cogit ceReturnToInterpreterPC
ifTrue: [self iframeSavedIP: lifp]
ifFalse: [lip].
self assert: (theIP >= (methodField + (objectMemory lastPointerOf: methodField))
+ and: [theIP < (methodField + (objectMemory numBytesOf: methodField) + objectMemory baseHeaderSize - 1)])
- and: [theIP < (methodField + (objectMemory byteLengthOf: methodField) + objectMemory baseHeaderSize - 1)])
l: ln].
self assert: ((self iframeIsBlockActivation: lifp)
or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self iframeReceiver: lifp)])
l: ln]
ifFalse:
[self assert: (self isMachineCodeFrame: lifp) l: ln.
((self asserta: methodField asUnsignedInteger >= cogit minCogMethodAddress l: ln)
and: [self asserta: methodField asUnsignedInteger < cogit maxCogMethodAddress l: ln]) ifTrue:
[cogMethod := self mframeHomeMethod: lifp.
self assert: (lip > (methodField + ((self mframeIsBlockActivation: lifp)
ifTrue: [self sizeof: CogBlockMethod]
ifFalse: [self sizeof: CogMethod]))
and: [lip < (methodField + cogMethod blockSize)])
l: ln].
self assert: ((self mframeIsBlockActivation: lifp)
or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self mframeReceiver: lifp)])
l: ln].
(self isBaseFrame: lifp) ifTrue:
[self assert: (self frameHasContext: lifp) l: ln.
self assert: (self frameContext: lifp) = (stackPages longAt: stackPage baseAddress - BytesPerWord) l: ln]!
Item was changed:
----- Method: CoInterpreter>>assertValidStackedInstructionPointersIn:line: (in category 'debug support') -----
assertValidStackedInstructionPointersIn: aStackPage line: ln
"Check that the stacked instruction pointers in the given page are correct.
Checks the interpreter sender/machine code callee contract."
<var: #aStackPage type: #'StackPage *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIP type: #usqInt>
<var: #theMethod type: #'CogMethod *'>
<inline: false>
| prevFrameWasCogged theFP callerFP theMethod theIP methodObj |
(self asserta: (stackPages isFree: aStackPage) not l: ln) ifFalse:
[^false].
prevFrameWasCogged := false.
"The top of stack of an inactive page is always the instructionPointer.
The top of stack of the active page may be the instructionPointer if it has been pushed,
which is indicated by a 0 instructionPointer."
(stackPage = aStackPage and: [instructionPointer ~= 0])
ifTrue:
[theIP := instructionPointer.
theFP := framePointer]
ifFalse:
[theIP := (stackPages longAt: aStackPage headSP) asUnsignedInteger.
theFP := aStackPage headFP.
stackPage = aStackPage ifTrue:
[self assert: framePointer = theFP l: ln]].
[(self isMachineCodeFrame: theFP)
ifTrue:
[theMethod := self mframeHomeMethod: theFP.
self assert: (theIP = cogit ceCannotResumePC
or: [theIP >= theMethod asUnsignedInteger
and: [theIP < (theMethod asUnsignedInteger + theMethod blockSize)]])
l: ln.
prevFrameWasCogged := true]
ifFalse: "assert-check the interpreter frame."
[methodObj := self iframeMethod: theFP.
prevFrameWasCogged ifTrue:
[self assert: theIP = cogit ceReturnToInterpreterPC l: ln].
theIP = cogit ceReturnToInterpreterPC ifTrue:
[theIP := self iframeSavedIP: theFP].
self assert: (theIP >= (methodObj + (objectMemory lastPointerOf: methodObj))
+ and: [theIP < (methodObj + (objectMemory numBytesOf: methodObj) + objectMemory baseHeaderSize - 1)])
- and: [theIP < (methodObj + (objectMemory byteLengthOf: methodObj) + objectMemory baseHeaderSize - 1)])
l: ln.
prevFrameWasCogged := false].
theIP := (stackPages longAt: theFP + FoxCallerSavedIP) asUnsignedInteger.
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theFP := callerFP].
self assert: theIP = cogit ceBaseFrameReturnPC l: ln.
^true!
Item was changed:
----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
printMethodCacheFor: thing
<api>
0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
[:i | | s c m p |
s := methodCache at: i + MethodCacheSelector.
c := methodCache at: i + MethodCacheClass.
m := methodCache at: i + MethodCacheMethod.
p := methodCache at: i + MethodCachePrimFunction.
((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing
or: [(objectMemory addressCouldBeObj: m)
and: [(self maybeMethodHasCogMethod: m)
and: [(self cogMethodOf: m) asInteger = thing]]]]]]])
and: [(objectMemory addressCouldBeOop: s)
and: [c ~= 0
and: [(self addressCouldBeClassObj: c)
or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
[self cCode: [] inSmalltalk: [self transcript ensureCr].
self printNum: i; cr; tab.
(objectMemory isBytesNonImm: s)
+ ifTrue: [self cCode: 'printf("%x %.*s\n", s, numBytesOf(s), (char *)firstIndexableField(s))'
- ifTrue: [self cCode: 'printf("%x %.*s\n", s, byteLengthOf(s), (char *)firstIndexableField(s))'
inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
ifFalse: [self shortPrintOop: s].
self tab.
(self addressCouldBeClassObj: c)
ifTrue: [self shortPrintOop: c]
ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
self tab; shortPrintOop: m; tab.
self cCode:
[p > 1024
ifTrue: [self printHexnp: p]
ifFalse: [self printNum: p]]
inSmalltalk:
[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
self cr]]!
Item was changed:
----- Method: CoInterpreterMT>>wakeHighestPriority (in category 'process primitive support') -----
wakeHighestPriority
"Return the highest priority process that is ready to run.
To save time looking at many empty lists before finding a
runnable process the VM maintains a variable holding the
highest priority runnable process. If this variable is 0 then the
VM does not know the highest priority and must search all lists.
Override to answer nil when there is no runnable process instead of
aborting. In the threaded VM the abort test is done in transferTo:from:
becaue there may be some thread waiting to own the VM. The transfer
to the thread shouldn't be done here because not all clients call this in
the right context (allowing a longjmp back to the threadSchedulingLoop)."
| schedLists p processList proc ctxt |
schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
p := highestRunnableProcessPriority = 0
+ ifTrue: [objectMemory numSlotsOf: schedLists]
- ifTrue: [objectMemory fetchWordLengthOf: schedLists]
ifFalse: [highestRunnableProcessPriority].
[(p := p - 1) >= 0] whileTrue:
[processList := objectMemory fetchPointer: p ofObject: schedLists.
[self isEmptyList: processList] whileFalse:
["Only answer processes with a runnable suspendedContext.
Discard those that aren't; the VM would crash otherwise."
proc := self removeFirstLinkOfList: processList.
ctxt := objectMemory fetchPointer: SuspendedContextIndex ofObject: proc.
(self isLiveContext: ctxt) ifTrue:
[highestRunnableProcessPriority := p + 1.
^proc].
self warning: 'evicted zombie process from run queue']].
^nil!
Item was changed:
----- Method: CogVMSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
classAndSelectorOfMethod: meth forReceiver: rcvr
| mClass dict length methodArray |
mClass := objectMemory fetchClassOf: rcvr.
[dict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: mClass.
+ length := objectMemory numSlotsOf: dict.
- length := objectMemory fetchWordLengthOf: dict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dict.
0 to: length-SelectorStart-1 do:
[:index |
meth = (objectMemory fetchPointer: index ofObject: methodArray)
ifTrue: [^ Array
with: mClass
with: (objectMemory fetchPointer: index + SelectorStart ofObject: dict)]].
mClass := objectMemory fetchPointer: SuperclassIndex ofObject: mClass.
mClass = objectMemory nilObject]
whileFalse: [].
^ Array
with: (objectMemory fetchClassOf: rcvr)
with: (objectMemory splObj: SelectorDoesNotUnderstand)!
Item was changed:
----- Method: Cogit>>bcpcsAndDescriptorsFor:do: (in category 'tests-method map') -----
bcpcsAndDescriptorsFor: aMethod do: trinaryBlock
<doNotGenerate>
| bsOffset nExts byte descriptor endpc latestContinuation pc primIdx |
((primIdx := coInterpreter primitiveIndexOf: aMethod) > 0
and: [coInterpreter isQuickPrimitiveIndex: primIdx]) ifTrue:
[^self].
latestContinuation := pc := coInterpreter startPCOfMethod: aMethod.
trinaryBlock value: pc value: nil value: nil. "stackCheck/entry pc"
bsOffset := self bytecodeSetOffsetFor: aMethod.
nExts := 0.
+ endpc := objectMemory numBytesOf: aMethod.
- endpc := objectMemory byteLengthOf: aMethod.
[pc <= endpc] whileTrue:
[byte := objectMemory fetchByte: pc ofObject: aMethod.
descriptor := self generatorAt: byte + bsOffset.
trinaryBlock value: pc value: byte value: descriptor.
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[endpc := pc].
(descriptor isBranch
or: [descriptor isBlockCreation]) ifTrue:
[| targetPC |
descriptor isBlockCreation ifTrue:
[trinaryBlock value: pc + descriptor numBytes value: nil value: nil]. "stackCheck/entry pc"
targetPC := self latestContinuationPCFor: descriptor at: pc exts: nExts in: aMethod.
self assert: targetPC < endpc.
latestContinuation := latestContinuation max: targetPC].
pc := pc + descriptor numBytes.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]!
Item was changed:
----- Method: Cogit>>blockStartPcsIn: (in category 'disassembly') -----
blockStartPcsIn: aMethod
"Answer the start bytecopde pcs in a method in compilation order, i.e. depth-first.
Blocks must occur in pc/depth-first order for binary tree block dispatch to work."
| startpcs pc latestContinuation end descriptor byte bsOffset nExts |
<doNotGenerate>
startpcs := OrderedCollection new.
startpcs add: (pc := latestContinuation := coInterpreter startPCOfMethod: aMethod).
+ end := objectMemory numBytesOf: aMethod.
- end := objectMemory byteLengthOf: aMethod.
bsOffset := self bytecodeSetOffsetFor: aMethod.
nExts := 0.
[pc <= end] whileTrue:
[byte := objectMemory fetchByte: pc ofObject: aMethod.
descriptor := self generatorAt: byte + bsOffset.
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[end := pc].
(descriptor isBranch
or: [descriptor isBlockCreation]) ifTrue:
[| targetPC |
targetPC := self latestContinuationPCFor: descriptor at: pc exts: nExts in: aMethod.
latestContinuation := latestContinuation max: targetPC].
pc := pc + descriptor numBytes.
descriptor isBlockCreation ifTrue:
[startpcs add: pc].
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
^startpcs!
Item was changed:
----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
compileCogMethod: selector
<returnTypeC: #'CogMethod *'>
| numBytecodes numBlocks numCleanBlocks result extra |
hasYoungReferent := (objectMemory isYoungObject: methodObj)
or: [objectMemory isYoung: selector].
methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
inBlock := false.
primInvokeLabel := nil.
postCompileHook := nil.
maxLitIndex := -1.
extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
ifTrue: [30]
ifFalse: [10].
initialPC := coInterpreter startPCOfMethod: methodObj.
"initial estimate. Actual endPC is determined in scanMethod."
endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
ifTrue: [initialPC - 1]
+ ifFalse: [objectMemory numBytesOf: methodObj].
- ifFalse: [objectMemory byteLengthOf: methodObj].
numBytecodes := endPC - initialPC + 1.
self allocateOpcodes: (numBytecodes + extra) * 10
bytecodes: numBytecodes
ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
(numBlocks := self scanMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
numCleanBlocks := self scanForCleanBlocks.
self allocateBlockStarts: numBlocks + numCleanBlocks.
blockCount := 0.
numCleanBlocks > 0 ifTrue:
[self addCleanBlockStarts].
(self maybeAllocAndInitCounters
and: [self maybeAllocAndInitIRCs]) ifFalse: "Inaccurate error code, but it'll do. This will likely never fail."
[^coInterpreter cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
blockEntryLabel := nil.
methodLabel dependent: nil.
(result := self compileEntireMethod) < 0 ifTrue:
[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
^self generateCogMethod: selector!
Item was changed:
----- Method: Cogit>>endPCOf: (in category 'compiled methods') -----
endPCOf: aMethod
<var: #descriptor type: #'BytecodeDescriptor *'>
| pc end latestContinuation descriptor prim distance targetPC byte bsOffset nExts |
pc := latestContinuation := coInterpreter startPCOfMethod: aMethod.
(prim := coInterpreter primitiveIndexOf: aMethod) > 0 ifTrue:
[(coInterpreter isQuickPrimitiveIndex: prim) ifTrue:
[^pc - 1]].
bsOffset := self bytecodeSetOffsetFor: aMethod.
nExts := 0.
+ end := objectMemory numBytesOf: aMethod.
- end := objectMemory byteLengthOf: aMethod.
[pc <= end] whileTrue:
[byte := objectMemory fetchByte: pc ofObject: aMethod.
descriptor := self generatorAt: byte + bsOffset.
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[end := pc].
(descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: aMethod.
targetPC := pc + descriptor numBytes + distance.
latestContinuation := latestContinuation max: targetPC.
descriptor isBlockCreation ifTrue:
[pc := pc + distance]].
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
pc := pc + descriptor numBytes].
^end!
Item was changed:
----- Method: Cogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
"Machine-code <-> bytecode pc mapping support. Evaluate functionSymbol
for each mcpc, bcpc pair in the map until the function returns non-zero,
answering that result, or 0 if it fails to. This works only for frameful methods."
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor *desc, sqInt isBackwardBranch, char *mcpc, sqInt bcpc, void *arg)'>
<var: #arg type: #'void *'>
<inline: true>
| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
latestContinuation byte descriptor bsOffset nExts |
<var: #descriptor type: #'BytecodeDescriptor *'>
<var: #homeMethod type: #'CogMethod *'>
self assert: cogMethod stackCheckOffset > 0.
"In both CMMethod and CMBlock cases find the start of the map and
skip forward to the bytecode pc map entry for the stack check."
cogMethod cmType = CMMethod
ifTrue:
[isInBlock := false.
homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
map := self mapStartFor: homeMethod.
self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
or: [(objectMemory byteAt: map) >> AnnotationShift = IsObjectReference
or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]]).
latestContinuation := startbcpc.
aMethodObj := homeMethod methodObject.
+ endbcpc := (objectMemory numBytesOf: aMethodObj) - 1.
- endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1.
bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
ifFalse:
[isInBlock := true.
homeMethod := cogMethod cmHomeMethod.
map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
inMethod: homeMethod.
self assert: map ~= 0.
self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
[map := map - 1].
map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
aMethodObj := homeMethod methodObject.
bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
descriptor := self generatorAt: byte.
endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
bcpc := startbcpc.
mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
nExts := 0.
"The stack check maps to the start of the first bytecode,
the first bytecode being effectively after frame build."
result := self perform: functionSymbol
with: nil
with: false
with: (self cCoerceSimple: mcpc to: #'char *')
with: startbcpc
with: arg.
result ~= 0 ifTrue:
[^result].
"Now skip up through the bytecode pc map entry for the stack check."
[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
[map := map - 1].
map := map - 1.
[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
[mapByte >= FirstAnnotation
ifTrue:
[| annotation nextBcpc isBackwardBranch |
annotation := mapByte >> AnnotationShift.
mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
(self isPCMappedAnnotation: annotation alternateInstructionSet: bsOffset > 0) ifTrue:
[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
descriptor := self generatorAt: byte.
isInBlock
ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
ifFalse:
[(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0].
(descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
[| targetPC |
targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
latestContinuation := latestContinuation max: targetPC]].
nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
descriptor isMapped
or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
[bcpc := nextBcpc.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
isBackwardBranch := descriptor isBranch
and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj].
result := self perform: functionSymbol
with: descriptor
with: isBackwardBranch
with: (self cCoerceSimple: mcpc to: #'char *')
with: bcpc
with: arg.
result ~= 0 ifTrue:
[^result].
bcpc := nextBcpc.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
self maybeRememberPrevMap: annotation absPCMcpc: mcpc]
ifFalse:
[mcpc := mcpc + (mapByte >= DisplacementX2N
ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
ifFalse: [mapByte])].
map := map - 1].
^0!
Item was changed:
----- Method: Cogit>>method:hasSameCodeAs: (in category 'garbage collection') -----
method: methodA hasSameCodeAs: methodB
"For the purposes of become: see if the two methods are similar, i.e. can be safely becommed.
This is pretty strict. All literals and bytecodes must be identical. Only trailer bytes and header
flags can differ."
<inline: false>
| headerA headerB numLitsA endPCA |
headerA := coInterpreter headerOf: methodA.
headerB := coInterpreter headerOf: methodB.
numLitsA := coInterpreter literalCountOfHeader: headerA.
endPCA := self endPCOf: methodA.
((coInterpreter argumentCountOfMethodHeader: headerA) ~= (coInterpreter argumentCountOfMethodHeader: headerB)
or: [(coInterpreter temporaryCountOfMethodHeader: headerA) ~= (coInterpreter temporaryCountOfMethodHeader: headerB)
or: [(coInterpreter primitiveIndexOfMethod: methodA header: headerA) ~= (coInterpreter primitiveIndexOfMethod: methodB header: headerB)
or: [numLitsA ~= (coInterpreter literalCountOfHeader: headerB)
+ or: [endPCA > (objectMemory numBytesOf: methodB)]]]]) ifTrue:
- or: [endPCA > (objectMemory byteLengthOf: methodB)]]]]) ifTrue:
[^false].
1 to: numLitsA - 1 do:
[:li|
(objectMemory fetchPointer: li ofObject: methodA) ~= (objectMemory fetchPointer: li ofObject: methodB) ifTrue:
[^false]].
(coInterpreter startPCOfMethod: methodA) to: endPCA do:
[:bi|
(objectMemory fetchByte: bi ofObject: methodA) ~= (objectMemory fetchByte: bi ofObject: methodB) ifTrue:
[^false]].
^true!
Item was changed:
----- Method: Cogit>>method:hasSameCodeAs:checkPenultimate: (in category 'garbage collection') -----
method: methodA hasSameCodeAs: methodB checkPenultimate: comparePenultimateLiteral
"For the purposes of become: see if the two methods are similar, i.e. can be safely becommed.
This is pretty strict. All literals and bytecodes must be identical. Only trailer bytes and header
flags can differ."
<inline: false>
| headerA headerB numLitsA endPCA |
headerA := coInterpreter headerOf: methodA.
headerB := coInterpreter headerOf: methodB.
numLitsA := coInterpreter literalCountOfHeader: headerA.
endPCA := self endPCOf: methodA.
((coInterpreter argumentCountOfMethodHeader: headerA) ~= (coInterpreter argumentCountOfMethodHeader: headerB)
or: [(coInterpreter temporaryCountOfMethodHeader: headerA) ~= (coInterpreter temporaryCountOfMethodHeader: headerB)
or: [(coInterpreter primitiveIndexOfMethod: methodA header: headerA) ~= (coInterpreter primitiveIndexOfMethod: methodB header: headerB)
or: [numLitsA ~= (coInterpreter literalCountOfHeader: headerB)
+ or: [endPCA > (objectMemory numBytesOf: methodB)]]]]) ifTrue:
- or: [endPCA > (objectMemory byteLengthOf: methodB)]]]]) ifTrue:
[^false].
1 to: numLitsA - 1 do:
[:li|
(objectMemory fetchPointer: li ofObject: methodA) ~= (objectMemory fetchPointer: li ofObject: methodB) ifTrue:
[(li < (numLitsA - 1) "If the method doesn't use the penultimate literal then don't fail the comparison."
or: [comparePenultimateLiteral]) ifTrue:
[^false]]].
(coInterpreter startPCOfMethod: methodA) to: endPCA do:
[:bi|
(objectMemory fetchByte: bi ofObject: methodA) ~= (objectMemory fetchByte: bi ofObject: methodB) ifTrue:
[^false]].
^true!
Item was changed:
----- Method: Cogit>>spanForCleanBlockStartingAt: (in category 'compile abstract instructions') -----
spanForCleanBlockStartingAt: startPC
<var: #descriptor type: #'BytecodeDescriptor *'>
| pc end descriptor |
pc := startPC.
+ end := objectMemory numBytesOf: methodObj.
- end := objectMemory byteLengthOf: methodObj.
[pc <= end] whileTrue:
[descriptor := self generatorAt: (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
pc := pc + descriptor numBytes.
descriptor isReturn ifTrue:
[^pc - startPC]].
self error: 'couldn''t locate end of clean block'.
^0!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>byteLengthOf: (in category 'accessing') -----
- byteLengthOf: anOop
- | obj |
- obj := self objectForOop: anOop.
- obj class isBytes ifTrue:
- [^obj basicSize].
- self error: 'cannot determine byte size of argument'!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>byteSizeOf: (in category 'accessing') -----
byteSizeOf: anOop
+ | obj elementSize |
+ obj := self objectForOop: anOop.
+ ([obj class isImmediateClass]
+ on: MessageNotUnderstood
+ do: [:ex| obj class == SmallInteger]) ifTrue:
+ [^0].
+ elementSize :=
+ [obj class elementSize]
+ on: MessageNotUnderstood
+ do: [:ex| obj class isBytes ifTrue: [1] ifFalse: [Smalltalk wordSize]].
+ ^obj basicSize * elementSize!
- ^(self objectForOop: anOop) basicSize!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>numBytesOf: (in category 'accessing') -----
+ numBytesOf: objOop
+ "Answer the number of indexable bytes in the given non-immediate object.
+ Does not adjust the size of contexts by stackPointer."
+ | obj elementSize |
+ obj := self objectForOop: objOop.
+ self deny: ([obj class isImmediateClass]
+ on: MessageNotUnderstood
+ do: [:ex| obj class == SmallInteger]).
+ elementSize :=
+ [obj class elementSize]
+ on: MessageNotUnderstood
+ do: [:ex| obj class isBytes ifTrue: [1] ifFalse: [Smalltalk wordSize]].
+ ^obj basicSize * elementSize!
Item was changed:
----- Method: Interpreter>>activateNewClosureMethod: (in category 'control primitives') -----
activateNewClosureMethod: blockClosure
"Similar to activateNewMethod but for Closure and newMethod."
| theBlockClosure closureMethod newContext methodHeader numCopied where outerContext |
DoAssertionChecks ifTrue:
[self okayOop: blockClosure].
outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
DoAssertionChecks ifTrue:
[self okayOop: outerContext].
closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
methodHeader := self headerOf: closureMethod.
self pushRemappableOop: blockClosure.
newContext := self allocateOrRecycleContext: (methodHeader bitAnd: LargeContextBit). "All for one, and one for all!!"
"allocateOrRecycleContext: may cause a GC; restore blockClosure and refetch outerContext et al"
theBlockClosure := self popRemappableOop.
outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: theBlockClosure.
+ numCopied := (self numSlotsOf: theBlockClosure) - ClosureFirstCopiedValueIndex.
- numCopied := (self fetchWordLengthOf: theBlockClosure) - ClosureFirstCopiedValueIndex.
"Assume: newContext will be recorded as a root if necessary by the
call to newActiveContext: below, so we can use unchecked stores."
where := newContext + BaseHeaderSize.
self longAt: where + (SenderIndex << ShiftForWord)
put: activeContext.
self longAt: where + (InstructionPointerIndex << ShiftForWord)
put: (self fetchPointer: ClosureStartPCIndex ofObject: theBlockClosure).
self longAt: where + (StackPointerIndex << ShiftForWord)
put: (self integerObjectOf: argumentCount + numCopied).
self longAt: where + (MethodIndex << ShiftForWord)
put: (self fetchPointer: MethodIndex ofObject: outerContext).
self longAt: where + (ClosureIndex << ShiftForWord)
put: theBlockClosure.
self longAt: where + (ReceiverIndex << ShiftForWord)
put: (self fetchPointer: ReceiverIndex ofObject: outerContext).
"Copy the arguments..."
1 to: argumentCount do:
[:i | self longAt: where + ((ReceiverIndex+i) << ShiftForWord)
put: (self stackValue: argumentCount-i)].
"Copy the copied values..."
where := newContext + BaseHeaderSize + ((ReceiverIndex + 1 + argumentCount) << ShiftForWord).
0 to: numCopied - 1 do:
[:i| self longAt: where + (i << ShiftForWord)
put: (self fetchPointer: i + ClosureFirstCopiedValueIndex
ofObject: theBlockClosure)].
"The initial instructions in the block nil-out remaining temps."
self pop: argumentCount + 1.
self newActiveContext: newContext!
Item was changed:
----- Method: Interpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
findClassOfMethod: meth forReceiver: rcvr
| currClass classDict classDictSize methodArray i done |
currClass := self fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := self fetchPointer: MethodDictionaryIndex ofObject: currClass.
+ classDictSize := self numSlotsOf: classDict.
- classDictSize := self fetchWordLengthOf: classDict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue: [
meth = (self fetchPointer: i ofObject: methodArray) ifTrue: [ ^currClass ].
i := i + 1.
].
currClass := self fetchPointer: SuperclassIndex ofObject: currClass.
done := currClass = nilObj.
].
^self fetchClassOf: rcvr "method not found in superclass chain"!
Item was changed:
----- Method: Interpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') -----
findSelectorOfMethod: meth forReceiver: rcvr
| currClass done classDict classDictSize methodArray i |
currClass := self fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := self fetchPointer: MethodDictionaryIndex ofObject: currClass.
+ classDictSize := self numSlotsOf: classDict.
- classDictSize := self fetchWordLengthOf: classDict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i <= (classDictSize - SelectorStart)] whileTrue: [
meth = (self fetchPointer: i ofObject: methodArray) ifTrue: [
^(self fetchPointer: i + SelectorStart ofObject: classDict)
].
i := i + 1.
].
currClass := self fetchPointer: SuperclassIndex ofObject: currClass.
done := currClass = nilObj.
].
^ nilObj "method not found in superclass chain"!
Item was changed:
----- Method: Interpreter>>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>
+ length := self numSlotsOf: dictionary.
- length := self fetchWordLengthOf: dictionary.
mask := length - SelectorStart - 1.
(self isIntegerObject: messageSelector)
ifTrue: [index := (mask bitAnd: (self integerValueOf: messageSelector)) + SelectorStart]
ifFalse: [index := (mask bitAnd: (self hashBitsOf: messageSelector)) + SelectorStart].
"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 := self fetchPointer: index ofObject: dictionary.
nextSelector = nilObj ifTrue: [^ false].
nextSelector = messageSelector
ifTrue: [methodArray := self fetchPointer: MethodArrayIndex ofObject: dictionary.
newMethod := self fetchPointer: index - SelectorStart ofObject: methodArray.
"Check if newMethod is a CompiledMethod."
(self isCompiledMethod: newMethod)
ifTrue: [primitiveIndex := self primitiveIndexOf: newMethod.
primitiveIndex > MaxPrimitiveIndex
ifTrue: ["If primitiveIndex is out of range, set to zero before putting in
cache. This is equiv to primFail, and avoids the need to check on
every send."
primitiveIndex := 0]]
ifFalse: ["indicate that this is no compiled method - use primitiveInvokeObjectAsMethod"
primitiveIndex := 248].
^ true].
index := index + 1.
index = length
ifTrue: [wrapAround
ifTrue: [^ false].
wrapAround := true.
index := SelectorStart]]!
Item was changed:
----- Method: Interpreter>>primitiveClosureCopyWithCopiedValues (in category 'control primitives') -----
primitiveClosureCopyWithCopiedValues
| newClosure copiedValues numCopiedValues numArgs |
numArgs := self stackIntegerValue: 1.
copiedValues := self stackTop.
self success: (self fetchClassOf: copiedValues) = (self splObj: ClassArray).
successFlag ifFalse:
[^self primitiveFail].
+ numCopiedValues := self numSlotsOf: copiedValues.
- numCopiedValues := self fetchWordLengthOf: copiedValues.
newClosure := self
closureNumArgs: numArgs
"greater by 1 due to preIncrement of localIP"
instructionPointer: instructionPointer + 2 - (method+BaseHeaderSize)
numCopiedValues: numCopiedValues.
"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
self storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: (self stackValue: 2).
numCopiedValues > 0 ifTrue:
["Allocation may have done a GC and copiedValues may have moved."
copiedValues := self stackTop.
0 to: numCopiedValues - 1 do:
[:i|
"Assume: have just allocated a new BlockClosure; it must be young.
Thus, can use unchecked stores."
self storePointerUnchecked: i + ClosureFirstCopiedValueIndex
ofObject: newClosure
withValue: (self fetchPointer: i ofObject: copiedValues)]].
self pop: 3 thenPush: newClosure!
Item was changed:
----- Method: Interpreter>>primitiveClosureValueWithArgs (in category 'control primitives') -----
primitiveClosureValueWithArgs
| argumentArray arraySize cntxSize blockClosure blockArgumentCount closureMethod index outerContext |
argumentArray := self stackTop.
(self isArray: argumentArray) ifFalse:
[^self primitiveFail].
"Check for enough space in thisContext to push all args"
+ arraySize := self numSlotsOf: argumentArray.
+ cntxSize := self numSlotsOf: activeContext.
- arraySize := self fetchWordLengthOf: argumentArray.
- cntxSize := self fetchWordLengthOf: activeContext.
(self stackPointerIndex + arraySize) < cntxSize ifFalse:
[^self primitiveFail].
blockClosure := self stackValue: argumentCount.
blockArgumentCount := self argumentCountOfClosure: blockClosure.
arraySize = blockArgumentCount ifFalse:
[^self primitiveFail].
"Somewhat paranoiac checks we need while debugging that we may be able to discard
in a robust system."
outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
(self isContext: outerContext) ifFalse:
[^self primitiveFail].
closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
"Check if the closure's method is actually a CompiledMethod."
(self isOopCompiledMethod: closureMethod) ifFalse:
[^self primitiveFail].
self popStack.
"Copy the arguments to the stack, and activate"
index := 1.
[index <= arraySize]
whileTrue:
[self push: (self fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
argumentCount := arraySize.
self activateNewClosureMethod: blockClosure.
self quickCheckForInterrupts!
Item was changed:
----- Method: Interpreter>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
primitiveDoPrimitiveWithArgs
| argumentArray arraySize index cntxSize primIdx |
argumentArray := self stackTop.
+ arraySize := self numSlotsOf: argumentArray.
+ cntxSize := self numSlotsOf: activeContext.
- arraySize := self fetchWordLengthOf: argumentArray.
- cntxSize := self fetchWordLengthOf: activeContext.
self success: self stackPointerIndex + arraySize < cntxSize.
(self isArray: argumentArray) ifFalse: [^ self primitiveFail].
primIdx := self stackIntegerValue: 1.
successFlag ifFalse: [^ self primitiveFail]. "invalid args"
"Pop primIndex and argArray, then push args in place..."
self pop: 2.
primitiveIndex := primIdx.
argumentCount := arraySize.
index := 1.
[index <= argumentCount]
whileTrue: [self push: (self fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
"Run the primitive (sets successFlag)"
self pushRemappableOop: argumentArray. "prim might alloc/gc"
lkupClass := nilObj.
self primitiveResponse.
argumentArray := self popRemappableOop.
successFlag
ifFalse: ["If primitive failed, then restore state for failure code"
self pop: arraySize.
self pushInteger: primIdx.
self push: argumentArray.
argumentCount := 2]!
Item was changed:
----- Method: Interpreter>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
primitiveExecuteMethodArgsArray
"receiver, argsArray, then method are on top of stack. Execute method against
receiver and args. Allow for up to two extra arguments (e.g. for mirror primitives).
Set primitiveFunctionPointer because no cache lookup has been done for the
method, and hence primitiveFunctionPointer is stale."
| methodArgument argCnt argumentArray |
methodArgument := self stackTop.
argumentArray := self stackValue: 1.
((self isOopCompiledMethod: methodArgument)
and: [self isArray: argumentArray]) ifFalse:
[^self primitiveFail].
argCnt := self argumentCountOf: methodArgument.
+ argCnt = (self numSlotsOf: argumentArray) ifFalse:
- argCnt = (self fetchWordLengthOf: argumentArray) ifFalse:
[^self primitiveFail].
argumentCount > 2 ifTrue: "CompiledMethod class>>receiver:withArguments:executeMethod:
SqueakObjectPrimitives class >> receiver:withArguments:apply:
VMMirror>>ifFail:object:with:executeMethod: et al"
[argumentCount > 4 ifTrue:
[^self primitiveFail].
self stackValue: argumentCount put: (self stackValue: 2)]. "replace actual receiver with desired receiver"
"and push the actual arguments"
self pop: argumentCount.
0 to: argCnt - 1 do:
[:i|
self push: (self fetchPointer: i ofObject: argumentArray)].
newMethod := methodArgument.
primitiveIndex := self primitiveIndexOf: newMethod.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil.
argumentCount := argCnt.
"We set the messageSelector for executeMethod below since things
like the at cache read messageSelector and so it cannot be left stale."
messageSelector := self nilObject.
self executeNewMethod.
"Recursive xeq affects successFlag"
successFlag := true!
Item was changed:
----- Method: Interpreter>>primitiveFormPrint (in category 'I/O primitives') -----
primitiveFormPrint
"On platforms that support it, this primitive prints the receiver, assumed to be a Form, to the default printer."
| landscapeFlag vScale hScale rcvr bitsArray w h
depth pixelsPerWord wordsPerLine bitsArraySize ok |
<var: #vScale type: 'double '>
<var: #hScale type: 'double '>
landscapeFlag := self booleanValueOf: self stackTop.
vScale := self floatValueOf: (self stackValue: 1).
hScale := self floatValueOf: (self stackValue: 2).
rcvr := self stackValue: 3.
(rcvr isIntegerObject: rcvr) ifTrue: [self success: false].
successFlag ifTrue: [
((self isPointers: rcvr) and: [(self lengthOf: rcvr) >= 4])
ifFalse: [self success: false]].
successFlag ifTrue: [
bitsArray := self fetchPointer: 0 ofObject: rcvr.
w := self fetchInteger: 1 ofObject: rcvr.
h := self fetchInteger: 2 ofObject: rcvr.
depth := self fetchInteger: 3 ofObject: rcvr.
(w > 0 and: [h > 0]) ifFalse: [self success: false].
pixelsPerWord := 32 // depth.
wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord.
((rcvr isIntegerObject: rcvr) not and: [self isWordsOrBytes: bitsArray])
ifTrue: [
+ bitsArraySize := self numBytesOf: bitsArray.
- bitsArraySize := self byteLengthOf: bitsArray.
self success: (bitsArraySize = (wordsPerLine * h * 4))]
ifFalse: [self success: false]].
successFlag ifTrue: [
ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize, w, h, depth, hScale, vScale, landscapeFlag)'.
self success: ok].
successFlag ifTrue: [
self pop: 3]. "pop hScale, vScale, and landscapeFlag; leave rcvr on stack"
!
Item was changed:
----- Method: Interpreter>>primitivePerformAt: (in category 'control primitives') -----
primitivePerformAt: lookupClass
"Common routine used by perform:withArgs: and perform:withArgs:inSuperclass:"
"NOTE: The case of doesNotUnderstand: is not a failure to perform.
The only failures are arg types and consistency of argumentCount."
| performSelector argumentArray arraySize index cntxSize performMethod performArgCount |
argumentArray := self stackTop.
(self isArray: argumentArray) ifFalse:[^self primitiveFail].
successFlag ifTrue:
["Check for enough space in thisContext to push all args"
+ arraySize := self numSlotsOf: argumentArray.
+ cntxSize := self numSlotsOf: activeContext.
- arraySize := self fetchWordLengthOf: argumentArray.
- cntxSize := self fetchWordLengthOf: activeContext.
self success: (self stackPointerIndex + arraySize) < cntxSize].
successFlag ifFalse: [^nil].
performSelector := messageSelector.
performMethod := newMethod.
performArgCount := argumentCount.
"pop the arg array and the selector, then push the args out of the array, as if they were on the stack"
self popStack.
messageSelector := self popStack.
"Copy the arguments to the stack, and execute"
index := 1.
[index <= arraySize]
whileTrue:
[self push: (self fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
argumentCount := arraySize.
self findNewMethodInClass: lookupClass.
"Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
(self isOopCompiledMethod: newMethod)
ifTrue: [self success: (self argumentCountOf: newMethod) = argumentCount].
successFlag
ifTrue: [self executeNewMethod. "Recursive xeq affects successFlag"
successFlag := true]
ifFalse: ["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
self pop: argumentCount.
self push: messageSelector.
self push: argumentArray.
messageSelector := performSelector.
newMethod := performMethod.
argumentCount := performArgCount]
!
Item was changed:
----- Method: Interpreter>>primitiveStopVMProfiling (in category 'process primitives') -----
primitiveStopVMProfiling
"Primitive. Stop the VM profiler and either copy the histogram data into the
supplied arguments, if they're non-nil. Fail if the arguments are not of the right type or size."
| vmHistArrayOrNil vmHist vmBins easHistArrayOrNil easHist easBins |
<var: #vmHist type: #'long *'>
<var: #vmBins type: #long>
<var: #easHist type: #'long *'>
<var: #easBins type: #long>
self success: argumentCount = 2.
vmHistArrayOrNil := self stackObjectValue: 1.
easHistArrayOrNil := self stackObjectValue: 0.
successFlag ifFalse:
[^nil].
"Both args must be either nil or arrays. If they're arrays and the wrong size we incorrectly stop profiling."
((vmHistArrayOrNil = nilObj or: [(self fetchClassOfNonImm: vmHistArrayOrNil) = (self splObj: ClassArray)])
and: [(self fetchClassOfNonImm: vmHistArrayOrNil) = (self fetchClassOfNonImm: easHistArrayOrNil)]) ifFalse:
[^self primitiveFail].
self cCode: 'ioControlProfile(0,&vmHist,&vmBins,&easHist,&easBins)'
inSmalltalk: [vmHist := vmBins := easHist := easBins := 0].
vmHistArrayOrNil ~= nilObj ifTrue:
+ [((self numSlotsOf: vmHistArrayOrNil) = vmBins
+ and: [(self numSlotsOf: easHistArrayOrNil) = easBins]) ifFalse:
- [((self fetchWordLengthOf: vmHistArrayOrNil) = vmBins
- and: [(self fetchWordLengthOf: easHistArrayOrNil) = easBins]) ifFalse:
[^self primitiveFail].
0 to: vmBins - 1 do:
[:i|
self storePointerUnchecked: i
ofObject: vmHistArrayOrNil
withValue: (self integerObjectOf: (vmHist at: i))].
0 to: easBins - 1 do:
[:i|
self storePointerUnchecked: i
ofObject: easHistArrayOrNil
withValue: (self integerObjectOf: (easHist at: i))]].
self pop: argumentCount!
Item was changed:
----- Method: Interpreter>>primitiveVMProfileInfoInto (in category 'process primitives') -----
primitiveVMProfileInfoInto
"Primitive. Answer whether the profiler is running or not.
If the argument is an Array of suitable size fill it with the following information:
1. the addresses of the first element of the VM histogram (the first address in the executable)
2. the address following the last element (the last address in the executable, excluding dynamically linked libraries)
3. the size of the VM histogram in bins (each bin is a 4 byte unsigned long)
4. the size of the VM histogram in bins (each bin is a 4 byte unsigned long)"
| info running exeStart exeLimit vmBins easBins |
<var: #exeStart type: #'char *'>
<var: #exeLimit type: #'char *'>
<var: #vmBins type: #long>
<var: #easBins type: #long>
self success: argumentCount = 1.
successFlag ifTrue:
[info := self stackObjectValue: 0.
info ~= nilObj ifTrue:
[self assertClassOf: info is: (self splObj: ClassArray).
+ self success: (self numSlotsOf: info) >= 4]].
- self success: (self fetchWordLengthOf: info) >= 4]].
successFlag ifFalse:
[^nil].
self cCode: 'ioProfileStatus(&running,&exeStart,&exeLimit,0,&vmBins,0,&easBins)'
inSmalltalk: [running := exeStart := exeLimit := vmBins := easBins := 0].
info ~= nilObj ifTrue:
[self storePointerUnchecked: 0
ofObject: info
withValue: (self integerObjectOf: (self oopForPointer: exeStart)).
self storePointerUnchecked: 1
ofObject: info
withValue: (self integerObjectOf: (self oopForPointer: exeLimit)).
self storePointerUnchecked: 2
ofObject: info
withValue: (self integerObjectOf: vmBins).
self storePointerUnchecked: 3
ofObject: info
withValue: (self integerObjectOf: easBins)].
self pop: 2 thenPushBool: running!
Item was changed:
----- Method: Interpreter>>primitiveVMProfileSamplesInto (in category 'process primitives') -----
primitiveVMProfileSamplesInto
"Primitive.
0 args: Answer whether the VM Profiler is running or not.
1 arg: Copy the sample data into the supplied argument, which must be a Bitmap
of suitable size. Answer the number of samples copied into the buffer."
| sampleBuffer sampleBufferAddress running bufferSize numSamples |
<var: #bufferSize type: #long>
<var: #sampleBufferAddress type: #'unsigned long *'>
self cCode: 'ioNewProfileStatus(&running,&bufferSize)'
inSmalltalk: [running := false. bufferSize := 0].
argumentCount = 0 ifTrue:
[^self pop: 1 thenPushBool: running].
self success: argumentCount = 1.
successFlag ifTrue:
[sampleBuffer := self stackObjectValue: 0.
self assertClassOf: sampleBuffer is: (self splObj: ClassBitmap).
+ self success: (self numSlotsOf: sampleBuffer) >= bufferSize].
- self success: (self fetchWordLengthOf: sampleBuffer) >= bufferSize].
successFlag ifFalse:
[^nil].
sampleBufferAddress := self firstFixedField: sampleBuffer.
numSamples := self cCode: 'ioNewProfileSamplesInto(sampleBufferAddress)'
inSmalltalk: [sampleBufferAddress := sampleBufferAddress].
self pop: argumentCount + 1 thenPushInteger: numSamples!
Item was changed:
----- Method: Interpreter>>primitiveValueWithArgs (in category 'control primitives') -----
primitiveValueWithArgs
| argumentArray blockContext blockArgumentCount arrayArgumentCount initialIP |
argumentArray := self popStack.
blockContext := self popStack.
blockArgumentCount := self argumentCountOfBlock: blockContext.
"If the argArray isnt actually an Array we ahve to unpop the above two"
(self isArray: argumentArray) ifFalse: [self unPop:2. ^self primitiveFail].
+ successFlag ifTrue: [arrayArgumentCount := self numSlotsOf: argumentArray.
- successFlag ifTrue: [arrayArgumentCount := self fetchWordLengthOf: argumentArray.
self success: (arrayArgumentCount = blockArgumentCount
and: [(self fetchPointer: CallerIndex ofObject: blockContext) = nilObj])].
successFlag
ifTrue: [self
transfer: arrayArgumentCount
fromIndex: 0
ofObject: argumentArray
toIndex: TempFrameStart
ofObject: blockContext.
"Assume: The call to transfer:... makes blockContext a root if necessary,
allowing use to use unchecked stored in the following code. "
initialIP := self fetchPointer: InitialIPIndex ofObject: blockContext.
self
storePointerUnchecked: InstructionPointerIndex
ofObject: blockContext
withValue: initialIP.
self storeStackPointerValue: arrayArgumentCount inContext: blockContext.
self
storePointerUnchecked: CallerIndex
ofObject: blockContext
withValue: activeContext.
self newActiveContext: blockContext]
ifFalse: [self unPop: 2]!
Item was changed:
----- Method: Interpreter>>wakeHighestPriority (in category 'process primitive support') -----
wakeHighestPriority
"Return the highest priority process that is ready to run."
"Note: It is a fatal VM error if there is no runnable process."
| schedLists p processList |
schedLists := self fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
+ p := self numSlotsOf: schedLists.
- p := self fetchWordLengthOf: schedLists.
p := p - 1.
"index of last indexable field"
processList := self fetchPointer: p ofObject: schedLists.
[self isEmptyList: processList]
whileTrue: [p := p - 1.
p < 0 ifTrue: [self error: 'scheduler could not find a runnable process'].
processList := self fetchPointer: p ofObject: schedLists].
^ self removeFirstLinkOfList: processList!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveClipboardText (in category 'I/O primitives') -----
primitiveClipboardText
"When called with a single string argument, post the string to
the clipboard. When called with zero arguments, return a
string containing the current clipboard contents."
| s sz |
argumentCount = 1
ifTrue:
[s := self stackTop.
(objectMemory isBytes: s) ifFalse: [^ self primitiveFail].
self successful ifTrue:
+ [sz := objectMemory numBytesOf: s.
- [sz := objectMemory byteLengthOf: s.
self clipboardWrite: sz From: s + objectMemory baseHeaderSize At: 0.
self pop: 1]]
ifFalse:
[sz := self clipboardSize.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[s := objectMemory allocateBytes: sz classIndex: ClassByteStringCompactIndex.
s ifNil: [^self primitiveFail]]
ifFalse:
[(objectMemory sufficientSpaceToAllocate: sz) ifFalse: [^self primitiveFail].
s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz].
self clipboardRead: sz Into: s + objectMemory baseHeaderSize At: 0.
self pop: 1 thenPush: s]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveClosureValueWithArgs (in category 'control primitives') -----
primitiveClosureValueWithArgs
| argumentArray arraySize blockClosure numArgs closureMethod index outerContext |
argumentArray := self stackTop.
(objectMemory isArray: argumentArray) ifFalse:
[^self primitiveFail].
"Check for enough space in thisContext to push all args"
+ arraySize := objectMemory numSlotsOf: argumentArray.
- arraySize := objectMemory fetchWordLengthOf: argumentArray.
(self roomToPushNArgs: arraySize) ifFalse:
[^self primitiveFail].
blockClosure := self stackValue: argumentCount.
numArgs := self argumentCountOfClosure: blockClosure.
arraySize = numArgs ifFalse:
[^self primitiveFail].
"Somewhat paranoiac checks we need while debugging that we may be able to discard
in a robust system."
outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
(objectMemory isContext: outerContext) ifFalse:
[^self primitiveFail].
closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
"Check if the closure's method is actually a CompiledMethod."
(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
[^self primitiveFail].
self popStack.
"Copy the arguments to the stack, and activate"
index := 1.
[index <= numArgs]
whileTrue:
[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
"Note we use activateNewMethod, not executeNewMethod, to avoid
quickCheckForInterrupts. Don't check until we have a full activation."
self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFormPrint (in category 'I/O primitives') -----
primitiveFormPrint
"On platforms that support it, this primitive prints the receiver, assumed to be a Form, to the default printer."
| landscapeFlag vScale hScale rcvr bitsArray w h
depth pixelsPerWord wordsPerLine bitsArraySize ok |
<var: #vScale type: 'double '>
<var: #hScale type: 'double '>
landscapeFlag := self booleanValueOf: self stackTop.
vScale := self floatValueOf: (self stackValue: 1).
hScale := self floatValueOf: (self stackValue: 2).
rcvr := self stackValue: 3.
((objectMemory isPointers: rcvr)
and: [(objectMemory lengthOf: rcvr) >= 4]) ifFalse:
[self success: false].
self successful ifTrue:
[bitsArray := objectMemory fetchPointer: 0 ofObject: rcvr.
w := self fetchInteger: 1 ofObject: rcvr.
h := self fetchInteger: 2 ofObject: rcvr.
depth := self fetchInteger: 3 ofObject: rcvr.
(w > 0 and: [h > 0]) ifFalse: [self success: false].
pixelsPerWord := 32 // depth.
wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord.
(objectMemory isWordsOrBytes: bitsArray)
ifTrue:
+ [bitsArraySize := objectMemory numBytesOf: bitsArray.
- [bitsArraySize := objectMemory byteLengthOf: bitsArray.
self success: (bitsArraySize = (wordsPerLine * h * 4))]
ifFalse: [self success: false]].
self successful ifTrue:
[ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize, w, h, depth, hScale, vScale, landscapeFlag)'.
self success: ok].
self successful ifTrue:
[self pop: 3] "pop hScale, vScale, and landscapeFlag; leave rcvr on stack"!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveShortAt (in category 'sound primitives') -----
primitiveShortAt
"Treat the receiver, which can be indexible by either bytes or words, as an array of signed 16-bit values. Return the contents of the given index. Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
+ | index rcvr value |
+ index := self stackTop..
+ (objectMemory isIntegerObject: index) ifFalse:
- | index rcvr sz addr value |
- index := self stackIntegerValue: 0.
- self successful ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
rcvr := self stackValue: 1.
(objectMemory isWordsOrBytes: rcvr) ifFalse:
[^self primitiveFailFor: PrimErrInappropriate].
+ ((index >= 1) and: [index <= (objectMemory num16BitUnitsOf: rcvr)]) ifFalse:
- sz := (objectMemory numSlotsOf: rcvr) * objectMemory bytesPerOop // 2. "number of 16-bit fields"
- ((index >= 1) and: [index <= sz]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
+ value := objectMemory fetchShort16: index - 1 ofObject: rcvr.
- addr := rcvr + objectMemory baseHeaderSize + (2 * (index - 1)).
- value := objectMemory shortAt: addr.
self pop: 2 thenPushInteger: value!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveShortAtPut (in category 'sound primitives') -----
primitiveShortAtPut
+ "Treat the receiver, which can be indexible by either bytes or words, as an array
+ of signed 16-bit values. Set the contents of the given index to the given value.
+ Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
- "Treat the receiver, which can be indexible by either bytes or words, as an array of signed 16-bit values. Set the contents of the given index to the given value. Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
+ | index rcvr value |
+ value := self stackTop.
+ index := self stackValue: 1.
+ ((objectMemory isIntegerObject: value)
+ and: [(objectMemory isIntegerObject: index)
+ and: [value := objectMemory integerValueOf: value.
+ (value >= -32768) and: [value <= 32767]]]) ifFalse:
- | index rcvr sz addr value |
- value := self stackIntegerValue: 0.
- index := self stackIntegerValue: 1.
- (self successful and: [(value >= -32768) and: [value <= 32767]]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
rcvr := self stackValue: 2.
(objectMemory isWordsOrBytes: rcvr) ifFalse:
[^self primitiveFailFor: PrimErrInappropriate].
+ (index >= 1 and: [index <= (objectMemory num16BitUnitsOf: rcvr)]) ifFalse:
- sz := ((objectMemory sizeBitsOf: rcvr) - BaseHeaderSize) // 2. "number of 16-bit fields"
- (index >= 1 and: [index <= sz]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
+ objectMemory storeShort16: index - 1 ofObject: rcvr withValue: value.
+ self pop: 3 thenPush: (objectMemory integerObjectOf: value)!
- addr := rcvr + BaseHeaderSize + (2 * (index - 1)).
- objectMemory shortAt: addr put: value.
- self pop: 3 thenPush: (objectMemory integerObjectOf: value) "pop all; return value"!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveStopVMProfiling (in category 'process primitives') -----
primitiveStopVMProfiling
"Primitive. Stop the VM profiler and either copy the histogram data into the
supplied arguments, if they're non-nil. Fail if the arguments are not of the right type or size."
| vmHistArrayOrNil vmHist vmBins easHistArrayOrNil easHist easBins |
<var: #vmHist type: #'long *'>
<var: #vmBins type: #long>
<var: #easHist type: #'long *'>
<var: #easBins type: #long>
self success: argumentCount = 2.
vmHistArrayOrNil := self stackObjectValue: 1.
easHistArrayOrNil := self stackObjectValue: 0.
self successful ifFalse:
[^nil].
"Both args must be either nil or arrays. If they're arrays and the wrong size we incorrectly stop profiling."
((vmHistArrayOrNil = objectMemory nilObject or: [(objectMemory fetchClassOfNonImm: vmHistArrayOrNil) = (objectMemory splObj: ClassArray)])
and: [(objectMemory fetchClassOfNonImm: vmHistArrayOrNil) = (objectMemory fetchClassOfNonImm: easHistArrayOrNil)]) ifFalse:
[^self primitiveFail].
self cCode: 'ioControlProfile(0,&vmHist,&vmBins,&easHist,&easBins)'
inSmalltalk: [vmHist := vmBins := easHist := easBins := 0].
vmHistArrayOrNil ~= objectMemory nilObject ifTrue:
+ [((objectMemory numSlotsOf: vmHistArrayOrNil) = vmBins
+ and: [(objectMemory numSlotsOf: easHistArrayOrNil) = easBins]) ifFalse:
- [((objectMemory fetchWordLengthOf: vmHistArrayOrNil) = vmBins
- and: [(objectMemory fetchWordLengthOf: easHistArrayOrNil) = easBins]) ifFalse:
[^self primitiveFail].
0 to: vmBins - 1 do:
[:i|
objectMemory storePointerUnchecked: i
ofObject: vmHistArrayOrNil
withValue: (objectMemory integerObjectOf: (vmHist at: i))].
0 to: easBins - 1 do:
[:i|
objectMemory storePointerUnchecked: i
ofObject: easHistArrayOrNil
withValue: (objectMemory integerObjectOf: (easHist at: i))]].
self pop: argumentCount!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveVMProfileInfoInto (in category 'process primitives') -----
primitiveVMProfileInfoInto
"Primitive. Answer whether the profiler is running or not.
If the argument is an Array of suitable size fill it with the following information:
1. the addresses of the first element of the VM histogram (the first address in the executable)
2. the address following the last element (the last address in the executable, excluding dynamically linked libraries)
3. the size of the VM histogram in bins (each bin is a 4 byte unsigned long)
4. the size of the VM histogram in bins (each bin is a 4 byte unsigned long)"
| info running exeStart exeLimit vmBins easBins |
<var: #exeStart type: #'char *'>
<var: #exeLimit type: #'char *'>
<var: #vmBins type: #long>
<var: #easBins type: #long>
self success: argumentCount = 1.
self successful ifTrue:
[info := self stackObjectValue: 0.
info ~= objectMemory nilObject ifTrue:
[self assertClassOf: info is: (objectMemory splObj: ClassArray).
+ self success: (objectMemory numSlotsOf: info) >= 4]].
- self success: (objectMemory fetchWordLengthOf: info) >= 4]].
self successful ifFalse:
[^nil].
self cCode: 'ioProfileStatus(&running,&exeStart,&exeLimit,0,&vmBins,0,&easBins)'
inSmalltalk: [running := exeStart := exeLimit := vmBins := easBins := 0].
info ~= objectMemory nilObject ifTrue:
[objectMemory storePointerUnchecked: 0
ofObject: info
withValue: (objectMemory integerObjectOf: (self oopForPointer: exeStart)).
objectMemory storePointerUnchecked: 1
ofObject: info
withValue: (objectMemory integerObjectOf: (self oopForPointer: exeLimit)).
objectMemory storePointerUnchecked: 2
ofObject: info
withValue: (objectMemory integerObjectOf: vmBins).
objectMemory storePointerUnchecked: 3
ofObject: info
withValue: (objectMemory integerObjectOf: easBins)].
self pop: 2 thenPushBool: running!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveVMProfileSamplesInto (in category 'process primitives') -----
primitiveVMProfileSamplesInto
"Primitive.
0 args: Answer whether the VM Profiler is running or not.
1 arg: Copy the sample data into the supplied argument, which must be a Bitmap
of suitable size. Answer the number of samples copied into the buffer."
| sampleBuffer sampleBufferAddress running bufferSize numSamples |
<var: #bufferSize type: #long>
<var: #sampleBufferAddress type: #'unsigned long *'>
self cCode: 'ioNewProfileStatus(&running,&bufferSize)'
inSmalltalk: [running := false. bufferSize := 0].
argumentCount = 0 ifTrue:
[^self pop: 1 thenPushBool: running].
self success: argumentCount = 1.
self successful ifTrue:
[sampleBuffer := self stackObjectValue: 0.
self assertClassOf: sampleBuffer is: (objectMemory splObj: ClassBitmap).
+ self success: (objectMemory numSlotsOf: sampleBuffer) >= bufferSize].
- self success: (objectMemory fetchWordLengthOf: sampleBuffer) >= bufferSize].
self successful ifFalse:
[^nil].
sampleBufferAddress := objectMemory firstFixedField: sampleBuffer.
numSamples := self cCode: 'ioNewProfileSamplesInto(sampleBufferAddress)'
inSmalltalk: [sampleBufferAddress := sampleBufferAddress].
self pop: argumentCount + 1 thenPushInteger: numSamples!
Item was added:
+ ----- Method: InterpreterProxy>>unpinObject: (in category 'object access') -----
+ unpinObject: anObject
+ <option: #(atLeastVMProxyMajor:minor: 1 13)>
+ ^self shouldBeImplemented!
Item was changed:
----- Method: InterpreterSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
classAndSelectorOfMethod: meth forReceiver: rcvr
| mClass dict length methodArray |
mClass := self fetchClassOf: rcvr.
[dict := self fetchPointer: MethodDictionaryIndex ofObject: mClass.
+ length := self numSlotsOf: dict.
- length := self fetchWordLengthOf: dict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: dict.
0 to: length-SelectorStart-1 do:
[:index |
meth = (self fetchPointer: index ofObject: methodArray)
ifTrue: [^ Array
with: mClass
with: (self fetchPointer: index + SelectorStart ofObject: dict)]].
mClass := self fetchPointer: SuperclassIndex ofObject: mClass.
mClass = nilObj]
whileFalse: [].
^ Array
with: (self fetchClassOf: rcvr)
with: (self splObj: SelectorDoesNotUnderstand)!
Item was removed:
- ----- Method: NewObjectMemory>>goodContextSize: (in category 'contexts') -----
- goodContextSize: oop
- | numSlots |
- numSlots := self numSlotsOf: oop.
- ^numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]!
Item was removed:
- ----- 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 changed:
----- Method: NewObjectMemory>>printWronglySizedContexts: (in category 'debug printing') -----
printWronglySizedContexts: printContexts
"Scan the heap printing the oops of any and all contexts whose size is not either SmallContextSize or LargeContextSize"
| oop |
<api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isContextNonImm: oop)
and: [self badContextSize: oop]) ifTrue:
+ [self printHex: oop; space; printNum: (self numBytesOf: oop); cr.
- [self printHex: oop; space; printNum: (self byteLengthOf: oop); cr.
printContexts ifTrue:
[coInterpreter printContext: oop]].
oop := self accessibleObjectAfter: oop]!
Item was changed:
+ ----- Method: NewObjectMemory>>sizeBitsOf: (in category 'object access') -----
- ----- Method: NewObjectMemory>>sizeBitsOf: (in category 'header access') -----
sizeBitsOf: oop
"Answer the number of bytes in the given object, including its base header, rounded up to an integral number of words."
"Note: byte indexable objects need to have low bits subtracted from this size."
<inline: true>
| header |
header := self baseHeader: oop.
^(header bitAnd: TypeMask) = HeaderTypeSizeAndClass
ifTrue: [(self sizeHeader: oop) bitAnd: LongSizeMask]
ifFalse: [header bitAnd: SizeMask]!
Item was changed:
+ ----- Method: NewObjectMemory>>sizeBitsOfSafe: (in category 'object access') -----
- ----- Method: NewObjectMemory>>sizeBitsOfSafe: (in category 'header access') -----
sizeBitsOfSafe: oop
"Compute the size of the given object from the cc and size fields in its header.
This works even if its type bits are not correct."
| header type |
header := self baseHeader: oop.
type := self rightType: header.
^type = HeaderTypeSizeAndClass
ifTrue: [(self sizeHeader: oop) bitAnd: AllButTypeMask]
ifFalse: [header bitAnd: SizeMask]!
Item was added:
+ ----- Method: NewObjectMemory>>unpinObject: (in category 'primitive support') -----
+ unpinObject: objOop
+ "For forward-compatibility with Spur. Fail; ObjectMemory does not support pinning."
+ <api>
+ coInterpreter primitiveFailFor: PrimErrUnsupported!
Item was changed:
----- Method: NewspeakInterpreter>>activateNewClosureMethod: (in category 'control primitives') -----
activateNewClosureMethod: blockClosure
"Similar to activateNewMethod but for Closure and newMethod."
| theBlockClosure closureMethod newContext methodHeader numCopied where outerContext |
DoAssertionChecks ifTrue:
[self okayOop: blockClosure].
outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
DoAssertionChecks ifTrue:
[self okayOop: outerContext].
closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
methodHeader := self headerOf: closureMethod.
self pushRemappableOop: blockClosure.
newContext := self allocateOrRecycleContext: (methodHeader bitAnd: LargeContextBit). "All for one, and one for all!!"
"allocateOrRecycleContext: may cause a GC; restore blockClosure and refetch outerContext et al"
theBlockClosure := self popRemappableOop.
outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: theBlockClosure.
+ numCopied := (self numSlotsOf: theBlockClosure) - ClosureFirstCopiedValueIndex.
- numCopied := (self fetchWordLengthOf: theBlockClosure) - ClosureFirstCopiedValueIndex.
"Assume: newContext will be recorded as a root if necessary by the
call to newActiveContext: below, so we can use unchecked stores."
where := newContext + BaseHeaderSize.
self longAt: where + (SenderIndex << ShiftForWord)
put: activeContext.
self longAt: where + (InstructionPointerIndex << ShiftForWord)
put: (self fetchPointer: ClosureStartPCIndex ofObject: theBlockClosure).
self longAt: where + (StackPointerIndex << ShiftForWord)
put: (self integerObjectOf: argumentCount + numCopied).
self longAt: where + (MethodIndex << ShiftForWord)
put: (self fetchPointer: MethodIndex ofObject: outerContext).
self longAt: where + (ClosureIndex << ShiftForWord)
put: theBlockClosure.
self longAt: where + (ReceiverIndex << ShiftForWord)
put: (self fetchPointer: ReceiverIndex ofObject: outerContext).
"Copy the arguments..."
1 to: argumentCount do:
[:i | self longAt: where + ((ReceiverIndex+i) << ShiftForWord)
put: (self stackValue: argumentCount-i)].
"Copy the copied values..."
where := newContext + BaseHeaderSize + ((ReceiverIndex + 1 + argumentCount) << ShiftForWord).
0 to: numCopied - 1 do:
[:i| self longAt: where + (i << ShiftForWord)
put: (self fetchPointer: i + ClosureFirstCopiedValueIndex
ofObject: theBlockClosure)].
"The initial instructions in the block nil-out remaining temps."
self pop: argumentCount + 1.
self newActiveContext: newContext!
Item was changed:
----- Method: NewspeakInterpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
findClassOfMethod: meth forReceiver: rcvr
| currClass classDict classDictSize methodArray i done |
currClass := self fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := self fetchPointer: MessageDictionaryIndex ofObject: currClass.
+ classDictSize := self numSlotsOf: classDict.
- classDictSize := self fetchWordLengthOf: classDict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue: [
meth = (self fetchPointer: i ofObject: methodArray) ifTrue: [ ^currClass ].
i := i + 1.
].
currClass := self fetchPointer: SuperclassIndex ofObject: currClass.
done := currClass = nilObj.
].
^self fetchClassOf: rcvr "method not found in superclass chain"!
Item was changed:
----- Method: NewspeakInterpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') -----
findSelectorOfMethod: meth forReceiver: rcvr
| currClass done classDict classDictSize methodArray i |
currClass := self fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := self fetchPointer: MessageDictionaryIndex ofObject: currClass.
+ classDictSize := self numSlotsOf: classDict.
- classDictSize := self fetchWordLengthOf: classDict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i <= (classDictSize - SelectorStart)] whileTrue: [
meth = (self fetchPointer: i ofObject: methodArray) ifTrue: [
^(self fetchPointer: i + SelectorStart ofObject: classDict)
].
i := i + 1.
].
currClass := self fetchPointer: SuperclassIndex ofObject: currClass.
done := currClass = nilObj.
].
^ nilObj "method not found in superclass chain"!
Item was changed:
----- Method: NewspeakInterpreter>>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>
+ length := self numSlotsOf: dictionary.
- length := self fetchWordLengthOf: dictionary.
mask := length - SelectorStart - 1.
(self isIntegerObject: messageSelector)
ifTrue: [index := (mask bitAnd: (self integerValueOf: messageSelector)) + SelectorStart]
ifFalse: [index := (mask bitAnd: (self hashBitsOf: messageSelector)) + SelectorStart].
"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 := self fetchPointer: index ofObject: dictionary.
nextSelector = nilObj ifTrue: [^ false].
nextSelector = messageSelector ifTrue:
[methodArray := self fetchPointer: MethodArrayIndex ofObject: dictionary.
newMethod := self fetchPointer: index - SelectorStart ofObject: methodArray.
^true].
index := index + 1.
index = length ifTrue:
[wrapAround ifTrue: [^false].
wrapAround := true.
index := SelectorStart]]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveClosureCopyWithCopiedValues (in category 'control primitives') -----
primitiveClosureCopyWithCopiedValues
| newClosure copiedValues numCopiedValues numArgs |
numArgs := self stackIntegerValue: 1.
copiedValues := self stackTop.
(self fetchClassOf: copiedValues) = (self splObj: ClassArray) ifFalse:
[^self primitiveFail].
+ numCopiedValues := self numSlotsOf: copiedValues.
- numCopiedValues := self fetchWordLengthOf: copiedValues.
newClosure := self
closureNumArgs: numArgs
"greater by 1 due to preIncrement of localIP"
instructionPointer: instructionPointer + 2 - (method+BaseHeaderSize)
numCopiedValues: numCopiedValues.
"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
self storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: (self stackValue: 2).
numCopiedValues > 0 ifTrue:
["Allocation may have done a GC and copiedValues may have moved."
copiedValues := self stackTop.
0 to: numCopiedValues - 1 do:
[:i|
"Assume: have just allocated a new BlockClosure; it must be young.
Thus, can use unchecked stores."
self storePointerUnchecked: i + ClosureFirstCopiedValueIndex
ofObject: newClosure
withValue: (self fetchPointer: i ofObject: copiedValues)]].
self pop: 3 thenPush: newClosure!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveClosureValueWithArgs (in category 'control primitives') -----
primitiveClosureValueWithArgs
| argumentArray arraySize cntxSize blockClosure blockArgumentCount closureMethod index outerContext |
argumentArray := self stackTop.
(self isArray: argumentArray) ifFalse:
[^self primitiveFail].
"Check for enough space in thisContext to push all args"
+ arraySize := self numSlotsOf: argumentArray.
+ cntxSize := self numSlotsOf: activeContext.
- arraySize := self fetchWordLengthOf: argumentArray.
- cntxSize := self fetchWordLengthOf: activeContext.
(self stackPointerIndex + arraySize) < cntxSize ifFalse:
[^self primitiveFail].
blockClosure := self stackValue: argumentCount.
blockArgumentCount := self argumentCountOfClosure: blockClosure.
arraySize = blockArgumentCount ifFalse:
[^self primitiveFail].
"Somewhat paranoiac checks we need while debugging that we may be able to discard
in a robust system."
outerContext := self fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
(self isContext: outerContext) ifFalse:
[^self primitiveFail].
closureMethod := self fetchPointer: MethodIndex ofObject: outerContext.
"Check if the closure's method is actually a CompiledMethod."
((self isNonIntegerObject: closureMethod) and: [self isCompiledMethod: closureMethod]) ifFalse:
[^self primitiveFail].
self popStack.
"Copy the arguments to the stack, and activate"
index := 1.
[index <= arraySize]
whileTrue:
[self push: (self fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
argumentCount := arraySize.
self activateNewClosureMethod: blockClosure.
self quickCheckForInterrupts!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
primitiveDoNamedPrimitiveWithArgs
"Simulate an primitiveExternalCall invocation (e.g. for the Debugger). Do not cache anything.
e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
| argumentArray arraySize index methodArg methodHeader spec
moduleName functionName moduleLength functionLength addr |
<var: #addr declareC: 'void (*addr)()'>
argumentArray := self stackTop.
(self isArray: argumentArray) ifFalse:
[^self primitiveFail]. "invalid args"
+ arraySize := self numSlotsOf: argumentArray.
- arraySize := self fetchWordLengthOf: argumentArray.
self success: (self roomToPushNArgs: arraySize).
methodArg := self stackObjectValue: 2.
self successful ifFalse:
[^self primitiveFail]. "invalid args"
(self isCompiledMethod: methodArg) ifFalse:
[^self primitiveFail]. "invalid args"
methodHeader := self headerOf: methodArg.
(self literalCountOfHeader: methodHeader) > 2 ifFalse:
[^self primitiveFail]. "invalid methodArg state"
self assertClassOf: (spec := self fetchPointer: 1 "first literal" ofObject: methodArg)
is: (self splObj: ClassArray).
(self successful
and: [(self lengthOf: spec) = 4
and: [(self primitiveIndexOfMethodHeader: methodHeader) = 117]]) ifFalse:
[^self primitiveFail]. "invalid methodArg state"
(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
[^self primitiveFail]. "invalid args (Array args wrong size)"
"The function has not been loaded yet. Fetch module and function name."
moduleName := self fetchPointer: 0 ofObject: spec.
moduleName = nilObj
ifTrue: [moduleLength := 0]
ifFalse: [self success: (self isBytes: moduleName).
moduleLength := self lengthOf: moduleName.
self cCode: '' inSmalltalk:
[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
ifTrue: [moduleLength := 0 "Cause all of these to fail"]]].
functionName := self fetchPointer: 1 ofObject: spec.
self success: (self isBytes: functionName).
functionLength := self lengthOf: functionName.
self successful ifFalse: [^self primitiveFail]. "invalid methodArg state"
addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
OfLength: functionLength
FromModule: moduleName + BaseHeaderSize
OfLength: moduleLength.
addr = 0 ifTrue:
[^self primitiveFail]. "could not find function"
"Cannot fail this primitive from now on. Can only fail the external primitive."
self pop: 1.
argumentCount := arraySize.
index := 1.
[index <= arraySize] whileTrue:
[self push: (self fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
"Run the primitive (sets primFailCode)"
self pushRemappableOop: argumentArray. "prim might alloc/gc in callback"
lkupClass := nilObj.
self callExternalPrimitive: addr.
argumentArray := self popRemappableOop.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[self pop: arraySize thenPush: argumentArray.
argumentCount := 3]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
primitiveDoPrimitiveWithArgs
| argumentArray arraySize index cntxSize primIdx |
argumentArray := self stackTop.
+ arraySize := self numSlotsOf: argumentArray.
+ cntxSize := self numSlotsOf: activeContext.
- arraySize := self fetchWordLengthOf: argumentArray.
- cntxSize := self fetchWordLengthOf: activeContext.
self success: self stackPointerIndex + arraySize < cntxSize.
(self isArray: argumentArray) ifFalse: [^ self primitiveFail].
primIdx := self stackIntegerValue: 1.
self successful ifFalse: [^ self primitiveFail]. "invalid args"
primitiveFunctionPointer := self functionPointerFor: primIdx inClass: nil.
primitiveFunctionPointer = 0 ifTrue:
[^self primitiveFail].
"Pop primIndex and argArray, then push args in place..."
self pop: 2.
argumentCount := arraySize.
index := 1.
[index <= argumentCount] whileTrue:
[self push: (self fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
self isPrimitiveFunctionPointerAnIndex ifTrue:
[self externalQuickPrimitiveResponse.
^nil].
"Run the primitive (sets successFlag)"
self pushRemappableOop: argumentArray. "prim might alloc/gc"
lkupClass := nilObj.
"Run the primitive (sets primFailCode)"
self slowPrimitiveResponse.
argumentArray := self popRemappableOop.
self successful ifFalse:
["If primitive failed, then restore state for failure code"
self pop: arraySize.
self pushInteger: primIdx.
self push: argumentArray.
argumentCount := 2]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
primitiveExecuteMethodArgsArray
"receiver, argsArray, then method are on top of stack. Execute method against
receiver and args. Allow for up to two extra arguments (e.g. for mirror primitives).
Set primitiveFunctionPointer because no cache lookup has been done for the
method, and hence primitiveFunctionPointer is stale."
| methodArgument argCnt argumentArray primitiveIndex |
methodArgument := self stackTop.
argumentArray := self stackValue: 1.
((self isOopCompiledMethod: methodArgument)
and: [self isArray: argumentArray]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
argCnt := self argumentCountOf: methodArgument.
+ argCnt = (self numSlotsOf: argumentArray) ifFalse:
- argCnt = (self fetchWordLengthOf: argumentArray) ifFalse:
[^self primitiveFailFor: PrimErrBadNumArgs].
argumentCount > 2 ifTrue: "CompiledMethod class>>receiver:withArguments:executeMethod:
SqueakObjectPrimitives class >> receiver:withArguments:apply:
VMMirror>>ifFail:object:with:executeMethod: et al"
[argumentCount > 4 ifTrue:
[^self primitiveFailFor: PrimErrUnsupported].
self stackValue: argumentCount put: (self stackValue: 2)]. "replace actual receiver with desired receiver"
"and push the actual arguments"
self pop: argumentCount.
0 to: argCnt - 1 do:
[:i|
self push: (self fetchPointer: i ofObject: argumentArray)].
newMethod := methodArgument.
primitiveIndex := self primitiveIndexOf: newMethod.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil.
argumentCount := argCnt.
"We set the messageSelector for executeMethod below since things
like the at cache read messageSelector and so it cannot be left stale."
messageSelector := self nilObject.
self executeNewMethod.
"Recursive xeq affects primErrorCode"
self initPrimCall!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveFormPrint (in category 'I/O primitives') -----
primitiveFormPrint
"On platforms that support it, this primitive prints the receiver, assumed to be a Form, to the default printer."
| landscapeFlag vScale hScale rcvr bitsArray w h
depth pixelsPerWord wordsPerLine bitsArraySize ok |
<var: #vScale type: 'double '>
<var: #hScale type: 'double '>
landscapeFlag := self booleanValueOf: self stackTop.
vScale := self floatValueOf: (self stackValue: 1).
hScale := self floatValueOf: (self stackValue: 2).
rcvr := self stackValue: 3.
(rcvr isIntegerObject: rcvr) ifTrue: [self success: false].
self successful ifTrue: [
((self isPointers: rcvr) and: [(self lengthOf: rcvr) >= 4])
ifFalse: [self success: false]].
self successful ifTrue: [
bitsArray := self fetchPointer: 0 ofObject: rcvr.
w := self fetchInteger: 1 ofObject: rcvr.
h := self fetchInteger: 2 ofObject: rcvr.
depth := self fetchInteger: 3 ofObject: rcvr.
(w > 0 and: [h > 0]) ifFalse: [self success: false].
pixelsPerWord := 32 // depth.
wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord.
((rcvr isIntegerObject: rcvr) not and: [self isWordsOrBytes: bitsArray])
ifTrue: [
+ bitsArraySize := self numBytesOf: bitsArray.
- bitsArraySize := self byteLengthOf: bitsArray.
self success: (bitsArraySize = (wordsPerLine * h * 4))]
ifFalse: [self success: false]].
self successful ifTrue: [
ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize, w, h, depth, hScale, vScale, landscapeFlag)'.
self success: ok].
self successful ifTrue: [
self pop: 3]. "pop hScale, vScale, and landscapeFlag; leave rcvr on stack"
!
Item was changed:
----- Method: NewspeakInterpreter>>primitivePerformAt: (in category 'control primitives') -----
primitivePerformAt: lookupClass
"Common routine used by perform:withArgs: and perform:withArgs:inSuperclass:"
"NOTE: The case of doesNotUnderstand: is not a failure to perform.
The only failures are arg types and consistency of argumentCount."
| performSelector argumentArray arraySize index cntxSize performMethod performArgCount |
argumentArray := self stackTop.
(self isArray: argumentArray) ifFalse:[^self primitiveFail].
self successful ifTrue:
["Check for enough space in thisContext to push all args"
+ arraySize := self numSlotsOf: argumentArray.
+ cntxSize := self numSlotsOf: activeContext.
- arraySize := self fetchWordLengthOf: argumentArray.
- cntxSize := self fetchWordLengthOf: activeContext.
self success: (self stackPointerIndex + arraySize) < cntxSize].
self successful ifFalse: [^nil].
performSelector := messageSelector.
performMethod := newMethod.
performArgCount := argumentCount.
"pop the arg array and the selector, then push the args out of the array, as if they were on the stack"
self popStack.
messageSelector := self popStack.
"Copy the arguments to the stack, and execute"
index := 1.
[index <= arraySize] whileTrue:
[self push: (self fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
argumentCount := arraySize.
self fastLogSend: messageSelector.
self sendBreakpoint: messageSelector receiver: receiver.
self findNewMethodInClass: lookupClass.
"Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
(self isCompiledMethod: newMethod)
ifTrue: [self success: (self argumentCountOf: newMethod) = argumentCount].
self successful
ifTrue: [self executeNewMethod. "Recursive xeq affects successFlag"
self initPrimCall]
ifFalse: ["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
self pop: argumentCount.
self push: messageSelector.
self push: argumentArray.
messageSelector := performSelector.
newMethod := performMethod.
argumentCount := performArgCount]
!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveVMProfileSamplesInto (in category 'process primitives') -----
primitiveVMProfileSamplesInto
"Primitive.
0 args: Answer whether the VM Profiler is running or not.
1 arg: Copy the sample data into the supplied argument, which must be a Bitmap
of suitable size. Answer the number of samples copied into the buffer."
| sampleBuffer sampleBufferAddress running bufferSize numSamples |
<var: #bufferSize type: #long>
<var: #sampleBufferAddress type: #'unsigned long *'>
self cCode: 'ioNewProfileStatus(&running,&bufferSize)'
inSmalltalk: [running := false. bufferSize := 0].
argumentCount = 0 ifTrue:
[^self pop: 1 thenPushBool: running].
self success: argumentCount = 1.
self successful ifTrue:
[sampleBuffer := self stackObjectValue: 0.
self assertClassOf: sampleBuffer is: (self splObj: ClassBitmap).
+ self success: (self numSlotsOf: sampleBuffer) >= bufferSize].
- self success: (self fetchWordLengthOf: sampleBuffer) >= bufferSize].
self successful ifFalse:
[^nil].
sampleBufferAddress := self firstFixedField: sampleBuffer.
numSamples := self cCode: 'ioNewProfileSamplesInto(sampleBufferAddress)'
inSmalltalk: [sampleBufferAddress := sampleBufferAddress].
self pop: argumentCount + 1 thenPushInteger: numSamples!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveValueWithArgs (in category 'control primitives') -----
primitiveValueWithArgs
| argumentArray blockContext blockArgumentCount arrayArgumentCount initialIP |
argumentArray := self popStack.
blockContext := self popStack.
blockArgumentCount := self argumentCountOfBlock: blockContext.
"If the argArray isnt actually an Array we ahve to unpop the above two"
(self isArray: argumentArray) ifFalse: [self unPop:2. ^self primitiveFail].
+ self successful ifTrue: [arrayArgumentCount := self numSlotsOf: argumentArray.
- self successful ifTrue: [arrayArgumentCount := self fetchWordLengthOf: argumentArray.
self success: (arrayArgumentCount = blockArgumentCount
and: [(self fetchPointer: CallerIndex ofObject: blockContext) = nilObj])].
self successful
ifTrue: [self
transfer: arrayArgumentCount
fromIndex: 0
ofObject: argumentArray
toIndex: TempFrameStart
ofObject: blockContext.
"Assume: The call to transfer:... makes blockContext a root if necessary,
allowing use to use unchecked stored in the following code. "
initialIP := self fetchPointer: InitialIPIndex ofObject: blockContext.
self
storePointerUnchecked: InstructionPointerIndex
ofObject: blockContext
withValue: initialIP.
self storeStackPointerValue: arrayArgumentCount inContext: blockContext.
self
storePointerUnchecked: CallerIndex
ofObject: blockContext
withValue: activeContext.
self newActiveContext: blockContext]
ifFalse: [self unPop: 2]!
Item was changed:
----- Method: NewspeakInterpreter>>printAllStacks (in category 'debug printing') -----
printAllStacks
"Print all the stacks of all running processes, including those that are currently suspended."
<api>
| oop classObj proc semaphoreClass schedLists processList |
<inline: false>
proc := self activeProcess.
self printNameOfClass: (self fetchClassOf: proc) count: 5; space; printHex: proc.
self print: ' priority '; printNum: (self quickFetchInteger: PriorityIndex ofObject: proc); cr.
self printContextCallStackOf: activeContext.
semaphoreClass := self classSemaphore.
oop := self firstObject.
[self oop: oop isLessThan: freeBlock] whileTrue:
[classObj := self fetchClassOfNonImm: oop.
(classObj = semaphoreClass) ifTrue:
[self printProcsOnList: oop].
oop := self objectAfter: oop].
schedLists := self fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
+ (self numSlotsOf: schedLists) - 1 to: 0 by: -1 do:
- (self fetchWordLengthOf: schedLists) - 1 to: 0 by: -1 do:
[:pri|
processList := self fetchPointer: pri ofObject: schedLists.
(self isEmptyList: processList) ifFalse:
[self cr; print: 'processes at priority '; printNum: pri + 1.
self printProcsOnList: processList]]!
Item was changed:
----- Method: NewspeakInterpreter>>validInstructionPointer:inMethod: (in category 'debug support') -----
validInstructionPointer: anInstrPointer inMethod: aMethod
^anInstrPointer >= (aMethod + (self lastPointerOf: aMethod) + 1)
+ and: [anInstrPointer < (aMethod + (self numBytesOf: aMethod))]!
- and: [anInstrPointer < (aMethod + (self byteLengthOf: aMethod))]!
Item was changed:
----- Method: NewspeakInterpreter>>wakeHighestPriority (in category 'process primitive support') -----
wakeHighestPriority
"Return the highest priority process that is ready to run."
"Note: It is a fatal VM error if there is no runnable process."
| schedLists p processList |
schedLists := self fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
+ p := self numSlotsOf: schedLists.
- p := self fetchWordLengthOf: schedLists.
p := p - 1.
"index of last indexable field"
processList := self fetchPointer: p ofObject: schedLists.
[self isEmptyList: processList]
whileTrue: [p := p - 1.
p < 0 ifTrue: [self error: 'scheduler could not find a runnable process'].
processList := self fetchPointer: p ofObject: schedLists].
^ self removeFirstLinkOfList: processList!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
classAndSelectorOfMethod: meth forReceiver: rcvr
| mClass dict length methodArray |
mClass := self fetchClassOf: rcvr.
[dict := self fetchPointer: MethodDictionaryIndex ofObject: mClass.
+ length := self numSlotsOf: dict.
- length := self fetchWordLengthOf: dict.
methodArray := self fetchPointer: MethodArrayIndex ofObject: dict.
0 to: length-SelectorStart-1 do:
[:index |
meth = (self fetchPointer: index ofObject: methodArray)
ifTrue: [^ Array
with: mClass
with: (self fetchPointer: index + SelectorStart ofObject: dict)]].
mClass := self fetchPointer: SuperclassIndex ofObject: mClass.
mClass = nilObj]
whileFalse: [].
^ Array
with: (self fetchClassOf: rcvr)
with: (self splObj: SelectorDoesNotUnderstand)!
Item was changed:
----- Method: ObjectMemory>>badContextSize: (in category 'contexts') -----
badContextSize: oop
+ ^(self numBytesOf: oop) ~= (SmallContextSize-BaseHeaderSize)
+ and: [(self numBytesOf: oop) ~= (LargeContextSize-BaseHeaderSize)]!
- ^(self byteLengthOf: oop) ~= (SmallContextSize-BaseHeaderSize)
- and: [(self byteLengthOf: oop) ~= (LargeContextSize-BaseHeaderSize)]!
Item was removed:
- ----- Method: ObjectMemory>>byteLengthOf: (in category 'indexing primitive support') -----
- byteLengthOf: obj
- "Return the number of indexable bytes in the given object.
- This is basically a special copy of lengthOf: for BitBlt. But it is also
- whoorishly used for the Cogit."
- <api>
- | header sz fmt |
- header := self baseHeader: obj.
- sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
- ifTrue: [(self sizeHeader: obj) bitAnd: AllButTypeMask]
- ifFalse: [header bitAnd: SizeMask].
- fmt := self formatOfHeader: header.
- ^fmt < self firstByteFormat
- ifTrue: [(sz - BaseHeaderSize)] "words"
- ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3)] "bytes"!
Item was changed:
+ ----- Method: ObjectMemory>>byteSizeOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>byteSizeOf: (in category 'object format') -----
byteSizeOf: oop
<api>
- | header format size |
(self isIntegerObject: oop) ifTrue:[^0].
+ ^self numBytesOf: oop!
- header := self baseHeader: oop.
- format := self formatOfHeader: header.
- size := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
- ifTrue: [(self sizeHeader: oop) bitAnd: LongSizeMask]
- ifFalse: [header bitAnd: SizeMask].
- size := size - (header bitAnd: Size4Bit).
- ^format < self firstByteFormat
- ifTrue: [ size - BaseHeaderSize "32-bit longs"]
- ifFalse: [ (size - BaseHeaderSize) - (format bitAnd: 3) "bytes"]!
Item was changed:
----- Method: ObjectMemory>>changeClassOf:to: (in category 'interpreter access') -----
changeClassOf: rcvr to: argClass
"Attempt to change the class of the receiver to the argument given that the
format of the receiver matches the format of the argument. If successful,
answer 0, otherwise answer an error code indicating the reason for failure.
Fail if the receiver is an instance of a compact class and the argument isn't,
or if the format of the receiver is incompatible with the format of the argument,
or if the argument is a fixed class and the receiver's size differs from the size
that an instance of the argument should have."
| classHdr sizeHiBits argClassInstByteSize argFormat rcvrFormat rcvrHdr ccIndex |
"Check what the format of the class says"
classHdr := self formatOfClass: argClass. "Low 2 bits are 0"
"Compute the size of instances of the class (used for fixed field classes only)"
sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
classHdr := classHdr bitAnd: 16r1FFFF.
argClassInstByteSize := (classHdr bitAnd: SizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
"Check the receiver's format against that of the class"
argFormat := self formatOfHeader: classHdr.
rcvrHdr := self baseHeader: rcvr.
rcvrFormat := self formatOfHeader: rcvrHdr.
"If the receiver is a byte object we need to clear the number of odd bytes from the format."
rcvrFormat > self firstByteFormat ifTrue:
[rcvrFormat := rcvrFormat bitAnd: 16rC].
argFormat = rcvrFormat ifFalse:
[^PrimErrInappropriate]. "no way"
"For fixed field classes, the sizes must match.
Note: argClassInstByteSize-4 because base header is included in class size."
argFormat < self arrayFormat
ifTrue:
+ [(argClassInstByteSize - BaseHeaderSize) ~= (self numBytesOf: rcvr) ifTrue:
- [(argClassInstByteSize - BaseHeaderSize) ~= (self byteLengthOf: rcvr) ifTrue:
[^PrimErrBadReceiver]]
ifFalse:
[argFormat = self indexablePointersFormat ifTrue: "For indexable plus fixed fields the receiver must be at least big enough."
+ [(argClassInstByteSize - BaseHeaderSize) > (self numBytesOf: rcvr) ifTrue:
- [(argClassInstByteSize - BaseHeaderSize) > (self byteLengthOf: rcvr) ifTrue:
[^PrimErrBadReceiver]]].
(self headerTypeOfHeader: rcvrHdr) = HeaderTypeShort
ifTrue: "Compact classes. Check if the arg's class is compact and exchange ccIndex"
[ccIndex := classHdr bitAnd: CompactClassMask.
ccIndex = 0 ifTrue:
[^PrimErrInappropriate]. "class is not compact"
self cppIf: IMMUTABILITY
ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
[^PrimErrNoModification]].
self baseHeader: rcvr put: ((rcvrHdr bitClear: CompactClassMask) bitOr: ccIndex)]
ifFalse: "Exchange the class pointer, which could make rcvr a root for argClass"
[self cppIf: IMMUTABILITY
ifTrue: [(rcvrHdr bitAnd: ImmutabilityBit) ~= 0 ifTrue:
[^PrimErrNoModification]].
"N.B. the recursive scan-mark algorithm uses the header word's size and compact class
fields to determine the header type when it reuses the header type bits for the mark
state. So it is alas an invariant that non-compact headers have a 0 compact class field."
(self compactClassIndexOfHeader: rcvrHdr) ~= 0 ifTrue:
[self baseHeader: rcvr put: (rcvrHdr bitClear: CompactClassMask)].
self longAt: rcvr - BaseHeaderSize put: (argClass bitOr: (self headerTypeOfHeader: rcvrHdr)).
(self oop: rcvr isLessThan: youngStart) ifTrue:
[self possibleRootStoreInto: rcvr value: argClass]].
"ok"
^0!
Item was changed:
+ ----- Method: ObjectMemory>>characterObjectOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>characterObjectOf: (in category 'primitive support') -----
characterObjectOf: characterCode
<api>
^(characterCode between: 0 and: 255)
ifTrue: [self fetchPointer: characterCode ofObject: self characterTable]
ifFalse: [nilObj]!
Item was changed:
+ ----- Method: ObjectMemory>>compactClassIndexOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>compactClassIndexOf: (in category 'header access') -----
compactClassIndexOf: oop
<api>
<inline: true>
^((self baseHeader: oop) >> self compactClassFieldLSB) bitAnd: 16r1F!
Item was changed:
+ ----- Method: ObjectMemory>>fetchByte:ofObject: (in category 'object access') -----
- ----- Method: ObjectMemory>>fetchByte:ofObject: (in category 'interpreter access') -----
fetchByte: byteIndex ofObject: oop
<api>
^self byteAt: oop + BaseHeaderSize + byteIndex!
Item was changed:
+ ----- Method: ObjectMemory>>fetchClassOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>fetchClassOf: (in category 'interpreter access') -----
fetchClassOf: oop
| ccIndex |
<inline: true>
<asmLabel: false>
^(self isIntegerObject: oop)
ifTrue: [self splObj: ClassSmallInteger]
ifFalse:
[(ccIndex := (self compactClassIndexOf: oop)) = 0
ifTrue: [(self classHeader: oop) bitAnd: AllButTypeMask]
ifFalse: [self compactClassAt: ccIndex]]!
Item was changed:
+ ----- Method: ObjectMemory>>fetchClassOfNonImm: (in category 'object access') -----
- ----- Method: ObjectMemory>>fetchClassOfNonImm: (in category 'interpreter access') -----
fetchClassOfNonImm: oop
| ccIndex |
<inline: true>
<asmLabel: false>
^(ccIndex := (self compactClassIndexOf: oop)) = 0
ifTrue: [(self classHeader: oop) bitAnd: AllButTypeMask]
ifFalse: [self compactClassAt: ccIndex]!
Item was changed:
+ ----- Method: ObjectMemory>>fetchLong32:ofObject: (in category 'object access') -----
- ----- Method: ObjectMemory>>fetchLong32:ofObject: (in category 'interpreter access') -----
fetchLong32: fieldIndex ofObject: oop
" index by 32-bit units, and return a 32-bit value. Intended to replace fetchWord:ofObject:"
^ self long32At: oop + BaseHeaderSize + (fieldIndex << 2)!
Item was removed:
- ----- Method: ObjectMemory>>fetchLong32LengthOf: (in category 'interpreter access') -----
- fetchLong32LengthOf: objectPointer
- "Gives size appropriate for, eg, fetchLong32"
-
- | sz |
- sz := self sizeBitsOf: objectPointer.
- ^ (sz - BaseHeaderSize) >> 2!
Item was added:
+ ----- Method: ObjectMemory>>fetchLong64:ofObject: (in category 'object access') -----
+ fetchLong64: longIndex ofObject: oop
+ <returnTypeC: #sqLong>
+ ^self long64At: oop + BaseHeaderSize + (8 * (longIndex - 1))!
Item was changed:
+ ----- Method: ObjectMemory>>fetchPointer:ofObject: (in category 'object access') -----
- ----- Method: ObjectMemory>>fetchPointer:ofObject: (in category 'interpreter access') -----
fetchPointer: fieldIndex ofObject: oop
"index by word size, and return a pointer as long as the word size"
<api>
^self longAt: oop + BaseHeaderSize + (fieldIndex << ShiftForWord)!
Item was added:
+ ----- Method: ObjectMemory>>fetchShort16:ofObject: (in category 'object access') -----
+ fetchShort16: shortIndex ofObject: oop
+ ^self shortAt: oop + BaseHeaderSize + (2 * (shortIndex - 1))!
Item was removed:
- ----- Method: ObjectMemory>>fetchWordLengthOf: (in category 'interpreter access') -----
- fetchWordLengthOf: objectPointer
- "NOTE: this gives size appropriate for fetchPointer: n, but not in general for, eg, fetchLong32, etc."
-
- | sz |
- sz := self sizeBitsOf: objectPointer.
- ^ (sz - BaseHeaderSize) >> ShiftForWord!
Item was changed:
+ ----- Method: ObjectMemory>>firstFixedField: (in category 'object access') -----
- ----- Method: ObjectMemory>>firstFixedField: (in category 'object format') -----
firstFixedField: oop
<returnTypeC: #'void *'>
^ self pointerForOop: oop + BaseHeaderSize!
Item was changed:
+ ----- Method: ObjectMemory>>formatOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>formatOf: (in category 'header access') -----
formatOf: oop
" 0 no fields
1 fixed fields only (all containing pointers)
2 indexable fields only (all containing pointers)
3 both fixed and indexable fields (all containing pointers)
4 both fixed and indexable weak fields (all containing pointers).
5 unused (reserved for ephemerons?)
6 indexable word fields only (no pointers)
7 indexable long (64-bit) fields (only in 64-bit images)
8-11 indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
12-15 compiled methods:
# of literal oops specified in method header,
followed by indexable bytes (same interpretation of low 2 bits as above)
"
<inline: true>
^((self baseHeader: oop) >> self instFormatFieldLSB) bitAnd: 16rF!
Item was changed:
+ ----- Method: ObjectMemory>>formatOfHeader: (in category 'object access') -----
- ----- Method: ObjectMemory>>formatOfHeader: (in category 'header access') -----
formatOfHeader: header
" 0 no fields
1 fixed fields only (all containing pointers)
2 indexable fields only (all containing pointers)
3 both fixed and indexable fields (all containing pointers)
4 both fixed and indexable weak fields (all containing pointers).
5 unused
6 indexable word fields only (no pointers)
7 indexable long (64-bit) fields (only in 64-bit images)
8-11 indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
12-15 compiled methods:
# of literal oops specified in method header,
followed by indexable bytes (same interpretation of low 2 bits as above)
"
<inline: true>
^header >> self instFormatFieldLSB bitAnd: 16rF!
Item was changed:
----- Method: ObjectMemory>>goodContextSize: (in category 'contexts') -----
goodContextSize: oop
+ | numSlots |
+ numSlots := self numSlotsOf: oop.
+ ^numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]!
- ^(self byteLengthOf: oop) = (SmallContextSize-BaseHeaderSize)
- or: [(self byteLengthOf: oop) = (LargeContextSize-BaseHeaderSize)]!
Item was changed:
+ ----- Method: ObjectMemory>>is:instanceOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>is:instanceOf: (in category 'header access') -----
is: oop instanceOf: classOop
"Answer if oop is an instance of the given class. If the class has a (non-zero)
compactClassIndex use that to speed up the check."
<inline: true>
(self isIntegerObject: oop) ifTrue:
[^classOop = (self splObj: ClassSmallInteger)].
^self isClassOfNonImm: oop equalTo: classOop!
Item was changed:
+ ----- Method: ObjectMemory>>is:instanceOf:compactClassIndex: (in category 'object access') -----
- ----- Method: ObjectMemory>>is:instanceOf:compactClassIndex: (in category 'header access') -----
is: oop instanceOf: classOop compactClassIndex: compactClassIndex
"Answer if oop is an instance of the given class. If the class has a (non-zero)
compactClassIndex use that to speed up the check. N.B. Inlining should
result in classOop not being accessed if oop's compact class index and
compactClassIndex are non-zero."
<inline: true>
(self isIntegerObject: oop) ifTrue:
[^false].
^self isClassOfNonImm: oop equalTo: classOop compactClassIndex: compactClassIndex!
Item was changed:
+ ----- Method: ObjectMemory>>isClassOfNonImm:equalTo:compactClassIndex: (in category 'object access') -----
- ----- Method: ObjectMemory>>isClassOfNonImm:equalTo:compactClassIndex: (in category 'header access') -----
isClassOfNonImm: oop equalTo: classOop compactClassIndex: compactClassIndex
"Answer if the given (non-immediate) object is an instance of the given class
that may have a compactClassIndex (if compactClassIndex is non-zero).
N.B. Inlining and/or compiler optimization should result in classOop not being
accessed if oop's compact class index and compactClassIndex are non-zero.
N.B. Generally one cannot assume that if compactClassIndex is non-zero the
instances of the corresponding class always have the compactClassIndex
because the compact class index is only non-zero in short header instances."
| ccIndex |
<inline: true>
<asmLabel: false>
self assert: (self isIntegerObject: oop) not.
ccIndex := self compactClassIndexOf: oop.
ccIndex = 0 ifTrue:
[^((self classHeader: oop) bitAnd: AllButTypeMask) = classOop].
compactClassIndex ~= 0 ifTrue:
[^compactClassIndex = ccIndex].
^classOop = (self compactClassAt: ccIndex)!
Item was changed:
+ ----- Method: ObjectMemory>>lengthOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>lengthOf: (in category 'indexing primitive support') -----
lengthOf: oop
"Return the number of indexable bytes or words in the given object. Assume the argument is not an integer. For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result."
<api>
| header |
<inline: true>
<asmLabel: false>
header := self baseHeader: oop.
^self lengthOf: oop baseHeader: header format: (self formatOfHeader: header)!
Item was changed:
+ ----- Method: ObjectMemory>>lengthOf:baseHeader:format: (in category 'object access') -----
- ----- Method: ObjectMemory>>lengthOf:baseHeader:format: (in category 'indexing primitive support') -----
lengthOf: oop baseHeader: hdr format: fmt
"Return the number of fixed and indexable bytes, words, or object pointers in the
given object. Assume the given oop is not an integer. For a CompiledMethod, the size
of the method header (in bytes) should be subtracted from the result of this method."
| sz |
<inline: true>
<asmLabel: false>
(hdr bitAnd: TypeMask) = HeaderTypeSizeAndClass
ifTrue: [ sz := (self sizeHeader: oop) bitAnd: LongSizeMask ]
ifFalse: [ sz := (hdr bitAnd: SizeMask)].
sz := sz - (hdr bitAnd: Size4Bit).
fmt <= self lastPointerFormat
ifTrue: [ ^ (sz - BaseHeaderSize) >> ShiftForWord "words"].
^fmt < self firstByteFormat
ifTrue: [(sz - BaseHeaderSize) >> 2 "32-bit longs"]
ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3) "bytes"]!
Item was added:
+ ----- Method: ObjectMemory>>num16BitUnitsOf: (in category 'object access') -----
+ num16BitUnitsOf: objOop
+ "Answer the number of 16-bit units in the given non-immediate object.
+ N..B. Rounds down 8-bit units, so a 5 byte object has 2 16-bit units.
+ Does not adjust the size of contexts by stackPointer."
+ ^(self numBytesOf: objOop) >> 1!
Item was added:
+ ----- Method: ObjectMemory>>num32BitUnitsOf: (in category 'object access') -----
+ num32BitUnitsOf: objOop
+ "Answer the number of 16-bit units in the given non-immediate object.
+ N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
+ Does not adjust the size of contexts by stackPointer."
+ ^(self numBytesOf: objOop) >> 2!
Item was added:
+ ----- Method: ObjectMemory>>num64BitUnitsOf: (in category 'object access') -----
+ num64BitUnitsOf: objOop
+ "Answer the number of 16-bit units in the given non-immediate object.
+ N..B. Rounds down 8-bit units, so a 15 byte object has 1 64-bit unit.
+ Does not adjust the size of contexts by stackPointer."
+ ^(self numBytesOf: objOop) >> 3!
Item was added:
+ ----- Method: ObjectMemory>>numBytesOf: (in category 'object access') -----
+ numBytesOf: objOop
+ "Answer the number of indexable bytes in the given non-immediate object.
+ Does not adjust the size of contexts by stackPointer."
+ <api>
+ | header sz fmt |
+ header := self baseHeader: objOop.
+ sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
+ ifTrue: [(self sizeHeader: objOop) bitAnd: AllButTypeMask]
+ ifFalse: [header bitAnd: SizeMask].
+ fmt := self formatOfHeader: header.
+ ^fmt < self firstByteFormat
+ ifTrue: [(sz - BaseHeaderSize)] "words"
+ ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3)] "bytes"!
Item was added:
+ ----- Method: ObjectMemory>>numSlotsOf: (in category 'object 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 changed:
----- Method: ObjectMemory>>printWronglySizedContexts (in category 'debug printing') -----
printWronglySizedContexts
"Scan the heap printing the oops of any and all contexts whose size is not either SmallContextSize or LargeContextSize"
| oop |
<api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isContextNonImm: oop)
and: [self badContextSize: oop]) ifTrue:
+ [self printHex: oop; space; printNum: (self numBytesOf: oop); cr].
- [self printHex: oop; space; printNum: (self byteLengthOf: oop); cr].
oop := self accessibleObjectAfter: oop]!
Item was changed:
+ ----- Method: ObjectMemory>>sizeBitsOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>sizeBitsOf: (in category 'header access') -----
sizeBitsOf: oop
"Answer the number of bytes in the given object, including its base header, rounded up to an integral number of words."
"Note: byte indexable objects need to have low bits subtracted from this size."
| header |
header := self baseHeader: oop.
(header bitAnd: TypeMask) = HeaderTypeSizeAndClass
ifTrue: [ ^ (self sizeHeader: oop) bitAnd: LongSizeMask ]
ifFalse: [ ^ header bitAnd: SizeMask ].!
Item was changed:
+ ----- Method: ObjectMemory>>sizeBitsOfSafe: (in category 'object access') -----
- ----- Method: ObjectMemory>>sizeBitsOfSafe: (in category 'header access') -----
sizeBitsOfSafe: oop
"Compute the size of the given object from the cc and size fields in its header. This works even if its type bits are not correct."
| header type |
header := self baseHeader: oop.
type := self rightType: header.
type = HeaderTypeSizeAndClass
ifTrue: [ ^ (self sizeHeader: oop) bitAnd: AllButTypeMask ]
ifFalse: [ ^ header bitAnd: SizeMask ].!
Item was changed:
+ ----- Method: ObjectMemory>>slotSizeOf: (in category 'object access') -----
- ----- Method: ObjectMemory>>slotSizeOf: (in category 'object format') -----
slotSizeOf: oop
"Returns the number of slots in the receiver.
If the receiver is a byte object, return the number of bytes.
Otherwise return the number of words."
(self isIntegerObject: oop) ifTrue:[^0].
^self lengthOf: oop!
Item was changed:
+ ----- Method: ObjectMemory>>storeByte:ofObject:withValue: (in category 'object access') -----
- ----- Method: ObjectMemory>>storeByte:ofObject:withValue: (in category 'interpreter access') -----
storeByte: byteIndex ofObject: oop withValue: valueByte
^ self byteAt: oop + BaseHeaderSize + byteIndex
put: valueByte!
Item was changed:
+ ----- Method: ObjectMemory>>storeLong32:ofObject:withValue: (in category 'object access') -----
- ----- Method: ObjectMemory>>storeLong32:ofObject:withValue: (in category 'interpreter access') -----
storeLong32: fieldIndex ofObject: oop withValue: valueWord
^ self long32At: oop + BaseHeaderSize + (fieldIndex << 2)
put: valueWord!
Item was added:
+ ----- Method: ObjectMemory>>storeLong64:ofObject:withValue: (in category 'object access') -----
+ storeLong64: longIndex ofObject: oop withValue: value
+ <var: #value type: #sqLong>
+ ^self long64At: oop + BaseHeaderSize + (8 * (longIndex - 1)) put: value!
Item was changed:
+ ----- Method: ObjectMemory>>storePointer:ofObject:withValue: (in category 'object access') -----
- ----- Method: ObjectMemory>>storePointer:ofObject:withValue: (in category 'interpreter access') -----
storePointer: fieldIndex ofObject: oop withValue: valuePointer
"Note must check here for stores of young objects into old ones."
(self oop: oop isLessThan: youngStart) ifTrue: [
self possibleRootStoreInto: oop value: valuePointer.
].
^ self longAt: oop + BaseHeaderSize + (fieldIndex << ShiftForWord)
put: valuePointer!
Item was changed:
+ ----- Method: ObjectMemory>>storePointerUnchecked:ofObject:withValue: (in category 'object access') -----
- ----- Method: ObjectMemory>>storePointerUnchecked:ofObject:withValue: (in category 'interpreter access') -----
storePointerUnchecked: fieldIndex ofObject: oop withValue: valuePointer
"Like storePointer:ofObject:withValue:, but the caller guarantees that the
object being stored into is a young object or is already marked as a root."
<api>
<inline: true>
^self
longAt: oop + BaseHeaderSize + (fieldIndex << ShiftForWord)
put: valuePointer!
Item was added:
+ ----- Method: ObjectMemory>>storeShort16:ofObject:withValue: (in category 'object access') -----
+ storeShort16: shortIndex ofObject: oop withValue: value
+ ^self shortAt: oop + BaseHeaderSize + (2 * (shortIndex - 1)) put: value!
Item was changed:
----- Method: Spur32BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
changeClassOf: rcvr to: argClass
"Attempt to change the class of the receiver to the argument given that the
format of the receiver matches the format of the argument. If successful,
answer 0, otherwise answer an error code indicating the reason for failure.
Fail if the format of the receiver is incompatible with the format of the argument,
or if the argument is a fixed class and the receiver's size differs from the size
that an instance of the argument should have."
<inline: false>
| classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex |
classFormat := self formatOfClass: argClass.
fixedFields := self fixedFieldsOfClassFormat: classFormat.
classFormat := self instSpecOfClassFormat: classFormat.
instFormat := self formatOf: rcvr.
normalizedInstFormat := self classFormatForInstanceFormat: instFormat.
(normalizedInstFormat > self lastPointerFormat
and: [normalizedInstFormat = classFormat])
ifTrue: [newFormat := instFormat]
ifFalse:
[normalizedInstFormat <= self lastPointerFormat
ifTrue:
[classFormat > self lastPointerFormat ifTrue:
[^PrimErrInappropriate].
(self numSlotsOf: rcvr) < fixedFields ifTrue:
[^PrimErrBadReceiver].
newFormat := classFormat]
ifFalse:
[| instBytes |
+ instBytes := self numBytesOf: rcvr.
- instBytes := self byteLengthOf: rcvr.
normalizedInstFormat caseOf: {
[self sixtyFourBitIndexableFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
newFormat := classFormat].
[self firstLongFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
(classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue:
[^PrimErrBadReceiver].
newFormat := classFormat].
[self firstShortFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
classFormat caseOf: {
[self sixtyFourBitIndexableFormat]
-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat].
[self firstLongFormat]
-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat].
[self firstByteFormat]
-> [newFormat := classFormat + (4 - instBytes bitAnd: 3)] }].
[self firstByteFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
classFormat caseOf: {
[self sixtyFourBitIndexableFormat]
-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]].
[self firstLongFormat]
-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]].
[self firstShortFormat]
-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]] }.
newFormat := classFormat].
[self firstCompiledMethodFormat] ->
[classFormat ~= self firstCompiledMethodFormat ifTrue:
[^PrimErrInappropriate].
newFormat := instFormat] }]].
(classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
[^classIndex negated].
self set: rcvr classIndexTo: classIndex formatTo: newFormat.
"ok"
^0!
Item was changed:
----- Method: Spur64BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
changeClassOf: rcvr to: argClass
"Attempt to change the class of the receiver to the argument given that the
format of the receiver matches the format of the argument. If successful,
answer 0, otherwise answer an error code indicating the reason for failure.
Fail if the format of the receiver is incompatible with the format of the argument,
or if the argument is a fixed class and the receiver's size differs from the size
that an instance of the argument should have."
<inline: false>
| classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex |
classFormat := self formatOfClass: argClass.
fixedFields := self fixedFieldsOfClassFormat: classFormat.
classFormat := self instSpecOfClassFormat: classFormat.
instFormat := self formatOf: rcvr.
normalizedInstFormat := self classFormatForInstanceFormat: instFormat.
(normalizedInstFormat > self lastPointerFormat
and: [normalizedInstFormat = classFormat])
ifTrue: [newFormat := instFormat]
ifFalse:
[normalizedInstFormat <= self lastPointerFormat
ifTrue:
[classFormat > self lastPointerFormat ifTrue:
[^PrimErrInappropriate].
(self numSlotsOf: rcvr) < fixedFields ifTrue:
[^PrimErrBadReceiver].
newFormat := classFormat]
ifFalse:
[| instBytes |
+ instBytes := self numBytesOf: rcvr.
- instBytes := self byteLengthOf: rcvr.
normalizedInstFormat caseOf: {
[self sixtyFourBitIndexableFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
newFormat := classFormat].
[self firstLongFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
(classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue:
[^PrimErrBadReceiver].
newFormat := classFormat].
[self firstShortFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
classFormat caseOf: {
[self sixtyFourBitIndexableFormat]
-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat].
[self firstLongFormat]
-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat + (2 - instBytes bitAnd: 1)].
[self firstByteFormat]
-> [newFormat := classFormat + (8 - instBytes bitAnd: 7)] }].
[self firstByteFormat] ->
[(classFormat < self sixtyFourBitIndexableFormat
or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
[^PrimErrInappropriate].
classFormat caseOf: {
[self sixtyFourBitIndexableFormat]
-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat].
[self firstLongFormat]
-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat + (2 - instBytes bitAnd: 1)].
[self firstShortFormat]
-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
newFormat := classFormat + (4 - instBytes bitAnd: 3)] }.
newFormat := classFormat].
[self firstCompiledMethodFormat] ->
[classFormat ~= self firstCompiledMethodFormat ifTrue:
[^PrimErrInappropriate].
newFormat := instFormat] }]].
(classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
[^classIndex negated].
self set: rcvr classIndexTo: classIndex formatTo: newFormat.
"ok"
^0!
Item was removed:
- ----- Method: SpurMemoryManager>>byteLengthOf: (in category 'object access') -----
- byteLengthOf: objOop
- "Answer the number of indexable bytes in the given object.
- Does not adjust contexts by stackPointer.
- This is basically a special copy of lengthOf: for BitBlt. But it is also
- whoorishly used for the Cogit."
- <api>
- | fmt numBytes |
- <inline: true>
- <asmLabel: false>
- fmt := self formatOf: objOop.
- numBytes := (self numSlotsOf: objOop) << self shiftForWord.
- fmt <= self sixtyFourBitIndexableFormat ifTrue:
- [^numBytes].
- fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod"
- [^numBytes - (fmt bitAnd: 7)].
- fmt >= self firstShortFormat ifTrue:
- [^numBytes - ((fmt bitAnd: 3) << 1)].
- "fmt >= self firstLongFormat"
- ^numBytes - ((fmt bitAnd: 1) << 2)!
Item was changed:
----- Method: SpurMemoryManager>>byteSizeOf: (in category 'object access') -----
byteSizeOf: oop
<api>
- | format |
(self isImmediate: oop) ifTrue: [^0].
+ ^self numBytesOf: oop!
- format := self formatOf: oop.
- format < self sixtyFourBitIndexableFormat ifTrue:
- [^(self numSlotsOf: oop) << self shiftForWord].
- format >= self firstByteFormat ifTrue:
- [^(self numSlotsOf: oop) << self shiftForWord - (format bitAnd: 7)].
- format >= self firstShortFormat ifTrue:
- [^(self numSlotsOf: oop) << self shiftForWord - ((format bitAnd: 3) << 1)].
- format >= self firstLongFormat ifTrue:
- [^(self numSlotsOf: oop) << self shiftForWord - ((format bitAnd: 1) << 2)].
- ^(self numSlotsOf: oop) << self shiftForWord!
Item was added:
+ ----- Method: SpurMemoryManager>>fetchLong64:ofObject: (in category 'object access') -----
+ fetchLong64: longIndex ofObject: objOop
+ <returnTypeC: #sqLong>
+ ^self long64At: objOop + self baseHeaderSize + (8 * (longIndex - 1))!
Item was added:
+ ----- Method: SpurMemoryManager>>fetchShort16:ofObject: (in category 'object access') -----
+ fetchShort16: shortIndex ofObject: objOop
+ ^self shortAt: objOop + self baseHeaderSize + (2 * (shortIndex - 1))!
Item was removed:
- ----- Method: SpurMemoryManager>>fetchWordLengthOf: (in category 'object access') -----
- fetchWordLengthOf: objOop
- "NOTE: this gives size appropriate for fetchPointer: n, but not in general for, eg, fetchLong32, etc.
- Unlike lengthOf: this does not adjust the length of a context
- by the stackPointer and so can be used e.g. by cloneContext:"
- ^self numSlotsOf: objOop!
Item was added:
+ ----- Method: SpurMemoryManager>>num16BitUnitsOf: (in category 'object access') -----
+ num16BitUnitsOf: objOop
+ "Answer the number of 16-bit units in the given non-immediate object.
+ N..B. Rounds down 8-bit units, so a 5 byte object has 2 16-bit units.
+ Does not adjust the size of contexts by stackPointer."
+ ^(self numBytesOf: objOop) >> 1!
Item was added:
+ ----- Method: SpurMemoryManager>>num32BitUnitsOf: (in category 'object access') -----
+ num32BitUnitsOf: objOop
+ "Answer the number of 16-bit units in the given non-immediate object.
+ N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit.
+ Does not adjust the size of contexts by stackPointer."
+ ^(self numBytesOf: objOop) >> 2!
Item was added:
+ ----- Method: SpurMemoryManager>>num64BitUnitsOf: (in category 'object access') -----
+ num64BitUnitsOf: objOop
+ "Answer the number of 16-bit units in the given non-immediate object.
+ N..B. Rounds down 8-bit units, so a 15 byte object has 1 64-bit unit.
+ Does not adjust the size of contexts by stackPointer."
+ ^(self numBytesOf: objOop) >> 3!
Item was added:
+ ----- Method: SpurMemoryManager>>numBytesOf: (in category 'object access') -----
+ numBytesOf: objOop
+ "Answer the number of indexable bytes in the given non-immediate object.
+ Does not adjust the size of contexts by stackPointer."
+ <api>
+ | fmt numBytes |
+ <inline: true>
+ <asmLabel: false>
+ fmt := self formatOf: objOop.
+ numBytes := self numSlotsOf: objOop.
+ numBytes := numBytes << self shiftForWord.
+ fmt <= self sixtyFourBitIndexableFormat ifTrue:
+ [^numBytes].
+ fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod"
+ [^numBytes - (fmt bitAnd: 7)].
+ fmt >= self firstShortFormat ifTrue:
+ [^numBytes - ((fmt bitAnd: 3) << 1)].
+ "fmt >= self firstLongFormat"
+ ^numBytes - ((fmt bitAnd: 1) << 2)!
Item was added:
+ ----- Method: SpurMemoryManager>>storeLong64:ofObject:withValue: (in category 'object access') -----
+ storeLong64: longIndex ofObject: objOop withValue: value
+ <var: #value type: #sqLong>
+ ^self long64At: objOop + self baseHeaderSize + (8 * (longIndex - 1)) put: value!
Item was added:
+ ----- Method: SpurMemoryManager>>storeShort16:ofObject:withValue: (in category 'object access') -----
+ storeShort16: shortIndex ofObject: objOop withValue: value
+ ^self shortAt: objOop + self baseHeaderSize + (2 * (shortIndex - 1)) put: value!
Item was added:
+ ----- Method: SpurMemoryManager>>unpinObject: (in category 'primitive support') -----
+ unpinObject: objOop
+ self assert: (self isNonImmediate: objOop).
+ self setIsPinnedOf: objOop to: false.
+ ^0!
Item was changed:
----- Method: StackInterpreter>>callPrimitiveBytecode (in category 'miscellaneous bytecodes') -----
callPrimitiveBytecode
+ "V4: 249 11111001 i i i i i i i i jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
+ self cppIf: SistaVM
+ ifTrue:
+ [| byte1 byte2 |
+ byte1 := self fetchByte.
+ byte2 := self fetchByte.
+ self fetchNextBytecode.
+ byte2 > 127
+ ifTrue:
+ [self inlinePrimitiveBytecode: (byte2 bitAnd: 16r7F) << 8 + byte1]
+ ifFalse:
+ [self error: 'non-inlined callPrimitiveBytecode should not be evaluated. method activation should step beyond this bytecode.']]
+ ifFalse:
+ [self error: 'callPrimitiveBytecode should not be evaluated. method activation should step beyond this bytecode.']
+
- "249 11111001 i i i i i i i i jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
- self error: 'should not be evaluated. method activation should step beyond this bytecode.'
"We could make it a noop and not skip it in {foo}ActivateMethod, as in:
localIP := localIP + 3.
self fetchNextBytecode
But for now, having {foo}ActivateMethod skip it makes it available for invoking embedded primitives."!
Item was changed:
----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:copiedValues: (in category 'control primitives') -----
closureIn: context numArgs: numArgs instructionPointer: initialIP copiedValues: copiedValues
| newClosure numCopied |
<inline: true>
"numCopied should be zero for nil"
+ numCopied := objectMemory numSlotsOf: copiedValues.
- numCopied := objectMemory fetchWordLengthOf: copiedValues.
ClassBlockClosureCompactIndex ~= 0
ifTrue:
[newClosure := objectMemory
eeInstantiateSmallClassIndex: ClassBlockClosureCompactIndex
format: objectMemory indexablePointersFormat
numSlots: ClosureFirstCopiedValueIndex + numCopied]
ifFalse:
[newClosure := objectMemory
eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
numSlots: ClosureFirstCopiedValueIndex + numCopied].
"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
objectMemory
storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context;
storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP);
storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs).
0 to: numCopied - 1 do:
[:i|
objectMemory storePointerUnchecked: i + ClosureFirstCopiedValueIndex
ofObject: newClosure
withValue: (objectMemory fetchPointer: i ofObject: copiedValues)].
^newClosure!
Item was changed:
----- Method: StackInterpreter>>copiedValueCountOfClosure: (in category 'internal interpreter access') -----
copiedValueCountOfClosure: closurePointer
<api> "for Cogit"
+ ^(objectMemory numSlotsOf: closurePointer) - ClosureFirstCopiedValueIndex!
- ^(objectMemory fetchWordLengthOf: closurePointer) - ClosureFirstCopiedValueIndex!
Item was changed:
----- Method: StackInterpreter>>findClassContainingMethod:startingAt: (in category 'debug support') -----
findClassContainingMethod: meth startingAt: classObj
| currClass classDict classDictSize methodArray i |
currClass := classObj.
[self assert: (objectMemory isForwarded: currClass) not.
classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass.
self assert: (objectMemory isForwarded: classDict) not.
+ classDictSize := objectMemory numSlotsOf: classDict.
- classDictSize := objectMemory fetchWordLengthOf: classDict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
self assert: (objectMemory isForwarded: methodArray) not.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue:
[meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
[^currClass].
i := i + 1].
currClass := self superclassOf: currClass.
currClass = objectMemory nilObject] whileFalse.
^currClass "method not found in superclass chain"!
Item was changed:
----- Method: StackInterpreter>>findClassForSelector:lookupClass:do: (in category 'debug support') -----
findClassForSelector: aSelector lookupClass: startClass do: unaryBlock
"Search startClass' class hierarchy looking for aSelector and if found, evaluate unaryBlock
with the class where the selector is found. Otherwise evaluate unaryBlock with nil."
| currClass classDict classDictSize i |
currClass := startClass.
[classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass.
+ classDictSize := objectMemory numSlotsOf: classDict.
- classDictSize := objectMemory fetchWordLengthOf: classDict.
i := SelectorStart.
[i < classDictSize] whileTrue:
[aSelector = (objectMemory fetchPointer: i ofObject: classDict) ifTrue:
[^unaryBlock value: currClass].
i := i + 1].
currClass := self superclassOf: currClass.
currClass = objectMemory nilObject] whileFalse.
^unaryBlock value: nil "selector not found in superclass chain"
!
Item was changed:
----- Method: StackInterpreter>>findSelectorAndClassForMethod:lookupClass:do: (in category 'debug support') -----
findSelectorAndClassForMethod: meth lookupClass: startClass do: binaryBlock
"Search startClass' class hierarchy searching for method and if found, evaluate aBinaryBlock
with the selector and class where the method is found. Otherwise evaluate aBinaryBlock
with doesNotUnderstand: and nil."
| currClass classDict classDictSize methodArray i |
currClass := startClass.
[classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass.
+ classDictSize := objectMemory numSlotsOf: classDict.
- classDictSize := objectMemory fetchWordLengthOf: classDict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i <= (classDictSize - SelectorStart)] whileTrue:
[meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
[^binaryBlock
value: (objectMemory fetchPointer: i + SelectorStart ofObject: classDict)
value: currClass].
i := i + 1].
currClass := self superclassOf: currClass.
currClass = objectMemory nilObject] whileFalse.
^binaryBlock "method not found in superclass chain"
value: (objectMemory splObj: SelectorDoesNotUnderstand)
value: nil!
Item was changed:
----- Method: StackInterpreter>>findSelectorOfMethod: (in category 'debug support') -----
findSelectorOfMethod: methArg
| meth classObj classDict classDictSize methodArray i |
(objectMemory addressCouldBeObj: methArg) ifFalse:
[^objectMemory nilObject].
(objectMemory isForwarded: methArg)
ifTrue: [meth := objectMemory followForwarded: methArg]
ifFalse: [meth := methArg].
(objectMemory isOopCompiledMethod: meth) ifFalse:
[^objectMemory nilObject].
classObj := self methodClassOf: meth.
(self addressCouldBeClassObj: classObj) ifTrue:
[classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: classObj.
+ classDictSize := objectMemory numSlotsOf: classDict.
- classDictSize := objectMemory fetchWordLengthOf: classDict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue:
[meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue:
[^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)].
i := i + 1]].
^objectMemory nilObject!
Item was changed:
----- Method: StackInterpreter>>highestPriorityProcess (in category 'process primitive support') -----
highestPriorityProcess
"Answer the highest priority process that is ready to run, but
unlike wakeHighestPriority do not remove it from the list.
To save time looking at many empty lists before finding a
runnable process the VM maintains a variable holding the
highest priority runnable process. If this variable is 0 then the
VM does not know the highest priority and must search all lists.
Note: It is a fatal VM error if there is no runnable process."
| schedLists p processList processOrNil |
<inline: false>
schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
p := highestRunnableProcessPriority = 0
+ ifTrue: [objectMemory numSlotsOf: schedLists]
- ifTrue: [objectMemory fetchWordLengthOf: schedLists]
ifFalse: [highestRunnableProcessPriority].
p := p - 1.
"index of last indexable field"
[processList := objectMemory fetchPointer: p ofObject: schedLists.
processOrNil := objectMemory fetchPointer: FirstLinkIndex ofObject: processList.
processOrNil = objectMemory nilObject] whileTrue:
[(p := p - 1) < 0 ifTrue:
[^nil]].
highestRunnableProcessPriority := p + 1.
^processOrNil!
Item was added:
+ ----- Method: StackInterpreter>>inlinePrimitiveBytecode: (in category 'miscellaneous bytecodes') -----
+ inlinePrimitiveBytecode: primIndex
+ "SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
+ <option: #SistaVM>
+ | result result64 |
+ primIndex caseOf: {
+ "0 unchecked SmallInteger #+. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [0] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ + (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "1 unchecked SmallInteger #-. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [1] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ - (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "2 unchecked SmallInteger #*. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [2] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ * (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "3 unchecked SmallInteger #/. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [3] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ / (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "4 unchecked SmallInteger #//. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [4] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ // (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "5 unchecked SmallInteger #\\. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [5] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ \\ (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "6 unchecked SmallInteger #quo:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [6] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ quo: (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+
+ "16 unchecked SmallInteger #bitAnd:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [16] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ bitAnd: (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "17 unchecked SmallInteger #bitOr:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [17] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ bitOr: (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "18 unchecked SmallInteger #bitXor:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [18] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ bitXor: (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+ "19 unchecked SmallInteger #bitShift:. Both arguments are SmallIntegers and the result fits in a SmallInteger (* depends on word size)"
+ [19] -> [result := objectMemory integerObjectOf: ((objectMemory integerValueOf: self internalStackTop)
+ bitShift: (objectMemory integerValueOf: (self internalStackValue: 1))).
+ self internalPop: 1; internalStackTopPut: result].
+
+ "32 unchecked SmallInteger #>. Both arguments are SmallIntegers"
+ [32] -> [result := objectMemory booleanObjectOf: (self internalStackTop > (self internalStackValue: 1)).
+ self internalPop: 1; internalStackTopPut: result].
+ "33 unchecked SmallInteger #<. Both arguments are SmallIntegers"
+ [33] -> [result := objectMemory booleanObjectOf: (self internalStackTop < (self internalStackValue: 1)).
+ self internalPop: 1; internalStackTopPut: result].
+ "34 unchecked SmallInteger #>=. Both arguments are SmallIntegers"
+ [34] -> [result := objectMemory booleanObjectOf: (self internalStackTop >= (self internalStackValue: 1)).
+ self internalPop: 1; internalStackTopPut: result].
+ "35 unchecked SmallInteger #<=. Both arguments are SmallIntegers"
+ [35] -> [result := objectMemory booleanObjectOf: (self internalStackTop <= (self internalStackValue: 1)).
+ self internalPop: 1; internalStackTopPut: result].
+ "36 unchecked SmallInteger #=. Both arguments are SmallIntegers"
+ [36] -> [result := objectMemory booleanObjectOf: (self internalStackTop = (self internalStackValue: 1)).
+ self internalPop: 1; internalStackTopPut: result].
+ "37 unchecked SmallInteger #~=. Both arguments are SmallIntegers"
+ [37] -> [result := objectMemory booleanObjectOf: (self internalStackTop ~= (self internalStackValue: 1)).
+ self internalPop: 1; internalStackTopPut: result].
+
+ "64 unchecked Pointer Object>>at:. The receiver is guaranteed to be a pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger"
+ [64] -> [result := objectMemory
+ fetchPointer: (objectMemory integerValueOf: self internalStackTop)
+ ofObject: (self internalStackValue: 1).
+ self internalPop: 1; internalStackTopPut: result].
+ "65 unchecked Byte Object>>at:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The result is a SmallInteger."
+ [65] -> [result := objectMemory
+ fetchByte: (objectMemory integerValueOf: self internalStackTop)
+ ofObject: (self internalStackValue: 1).
+ self internalPop: 1; internalStackTopPut: (objectMemory integerObjectOf: result)].
+ "66 unchecked Word Object>>at:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The result is a SmallInteger."
+ [66] -> [result := objectMemory
+ fetchShort: (objectMemory integerValueOf: self internalStackTop)
+ ofObject: (self internalStackValue: 1).
+ self internalPop: 1; internalStackTopPut: (objectMemory integerObjectOf: result)].
+ "67 unchecked DoubleWord Object>>at:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The result is a SmallInteger or a LargePositiveInteger."
+ [67] -> [result := objectMemory
+ fetchLong32: (objectMemory integerValueOf: self internalStackTop)
+ ofObject: (self internalStackValue: 1).
+ self internalPop: 1; internalStackTopPut: (self signed64BitValueOf: result)].
+ "68 unchecked QuadWord Object>>at:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The result is a SmallInteger or a LargePositiveInteger."
+ [68] -> [result64 := objectMemory
+ fetchLong64: (objectMemory integerValueOf: self internalStackTop)
+ ofObject: (self internalStackValue: 1).
+ self internalPop: 1; internalStackTopPut: (self signed64BitValueOf: result)].
+
+ "80 unchecked Pointer Object>>at:put:. The receiver is guaranteed to be a pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger"
+ [80] -> [result := self internalStackTop.
+ objectMemory
+ storePointer: (objectMemory integerValueOf: (self internalStackValue: 1))
+ ofObject: (self internalStackValue: 1)
+ withValue: result.
+ self internalPop: 2; internalStackTopPut: result].
+ "81 unchecked Byte Object>>at:put:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The argument is a SmallInteger. The primitive stores the least significant 8 bits."
+ [81] -> [result := self internalStackTop.
+ objectMemory
+ storeByte: (objectMemory integerValueOf: (self internalStackValue: 1))
+ ofObject: (self internalStackValue: 1)
+ withValue: (objectMemory integerValueOf: result).
+ self internalPop: 2; internalStackTopPut: result].
+ "82 unchecked Word Object>>at:put:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The argument is a SmallInteger. The primitive stores the least significant 16 bits."
+ [82] -> [result := self internalStackTop.
+ objectMemory
+ storeShort: (objectMemory integerValueOf: (self internalStackValue: 1))
+ ofObject: (self internalStackValue: 1)
+ withValue: (objectMemory integerValueOf: result).
+ self internalPop: 2; internalStackTopPut: result].
+ "83 unchecked DoubleWord Object>>at:put:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The argument is a SmallInteger. The primitive stores the least significant 32 bits."
+ [83] -> [result := self internalStackTop.
+ objectMemory
+ storeLong32: (objectMemory integerValueOf: (self internalStackValue: 1))
+ ofObject: (self internalStackValue: 1)
+ withValue: (objectMemory integerValueOf: result).
+ self internalPop: 2; internalStackTopPut: result].
+ "84 unchecked QuadWord Object>>at:put:. The receiver is guaranteed to be a non-pointer object. The 0-relative (1-relative?) index is an in-range SmallInteger. The argument is a SmallInteger. The primitive stores the least significant 64 bits."
+ [84] -> [result := self internalStackTop.
+ objectMemory
+ storeLong64: (objectMemory integerValueOf: (self internalStackValue: 1))
+ ofObject: (self internalStackValue: 1)
+ withValue: (objectMemory integerValueOf: result).
+ self internalPop: 2; internalStackTopPut: result] }
+ otherwise:
+ [localIP := localIP - 3.
+ self respondToUnknownBytecode]!
Item was changed:
----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
longPrintOop: oop
<api>
| fmt lastIndex startIP bytecodesPerLine column |
((objectMemory isImmediate: oop)
or: [(objectMemory addressCouldBeObj: oop) not
or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
or: [(objectMemory isFreeObject: oop)
or: [objectMemory isForwarded: oop]]]]) ifTrue:
[self printOop: oop.
^self].
self printHex: oop.
(objectMemory fetchClassOfNonImm: oop)
ifNil: [self print: ' has a nil class!!!!']
ifNotNil: [:class|
self print: ': a(n) '; printNameOfClass: class count: 5;
print: ' ('.
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>'].
self printHexnp: class; print: ')'].
fmt := objectMemory formatOf: oop.
self print: ' format '; printHexnp: fmt.
fmt > objectMemory lastPointerFormat
+ ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)]
- ifTrue: [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)]
ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
[| len |
len := objectMemory lengthOf: oop.
self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
objectMemory printHeaderTypeOf: oop.
self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
self cr.
(fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
[^self printStringOf: oop; cr].
(fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue:
[^self].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:i| | fieldOop |
fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
self space; printNum: i - 1; space; printHex: fieldOop; space.
(i = 1 and: [objectMemory isCompiledMethod: oop])
ifTrue: [self printMethodHeaderOop: fieldOop]
ifFalse: [self cCode: [self printOopShort: fieldOop]
inSmalltalk: [self print: (self shortPrint: fieldOop)]].
self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * BytesPerWord + 1.
lastIndex := objectMemory lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
column = 1 ifFalse:
[self cr]]!
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 numSlotsOf: dictionary.
- length := objectMemory fetchWordLengthOf: dictionary.
mask := length - SelectorStart - 1.
index := SelectorStart + (objectMemory methodDictionaryHash: selector mask: mask).
"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 isOopForwarded: nextSelector) ifTrue:
[nextSelector := objectMemory
fixFollowedField: index + SelectorStart
ofObject: dictionary
withInitialValue: nextSelector].
nextSelector = selector ifTrue:
[methodArray := objectMemory followObjField: MethodArrayIndex ofObject: dictionary.
^objectMemory followField: 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 numSlotsOf: dictionary.
- 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 isOopForwarded: nextSelector) ifTrue:
[nextSelector := objectMemory
fixFollowedField: index + SelectorStart
ofObject: dictionary
withInitialValue: nextSelector].
nextSelector = messageSelector ifTrue:
[methodArray := objectMemory followObjField: MethodArrayIndex ofObject: dictionary.
newMethod := objectMemory followField: index ofObject: methodArray.
^true].
index := index + 1].
^false].
index := SelectorStart + (objectMemory methodDictionaryHash: messageSelector mask: mask).
"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 isOopForwarded: nextSelector) ifTrue:
[nextSelector := objectMemory
fixFollowedField: index + SelectorStart
ofObject: dictionary
withInitialValue: nextSelector].
nextSelector = messageSelector ifTrue:
[methodArray := objectMemory followObjField: 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 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 numSlotsOf: argumentArray.
- arraySize := objectMemory fetchWordLengthOf: argumentArray.
arraySize > LargeContextSlots 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 sendBreakpoint: messageSelector receiver: actualReceiver.
self printSends ifTrue:
[self printActivationNameForSelector: messageSelector startClass: lookupClass; cr].
self findNewMethodInClassTag: (objectMemory classTagForClass: 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>>printAllStacks (in category 'debug printing') -----
printAllStacks
"Print all the stacks of all running processes, including those that are currently suspended."
<api>
| proc semaphoreClass mutexClass schedLists p processList |
<inline: false>
proc := self activeProcess.
self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5; space; printHex: proc.
self print: ' priority '; printNum: (self quickFetchInteger: PriorityIndex ofObject: proc); cr.
self printCallStackFP: framePointer. "first the current activation"
schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
"then the runnable processes"
p := highestRunnableProcessPriority = 0
+ ifTrue: [objectMemory numSlotsOf: schedLists]
- ifTrue: [objectMemory fetchWordLengthOf: schedLists]
ifFalse: [highestRunnableProcessPriority].
p - 1 to: 0 by: -1 do:
[:pri|
processList := objectMemory fetchPointer: pri ofObject: schedLists.
(self isEmptyList: processList) ifFalse:
[self cr; print: 'processes at priority '; printNum: pri + 1.
self printProcsOnList: processList]].
self cr; print: 'suspended processes'.
semaphoreClass := objectMemory classSemaphore.
mutexClass := objectMemory classMutex.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[semaphoreClass := objectMemory compactIndexOfClass: semaphoreClass.
mutexClass := objectMemory compactIndexOfClass: mutexClass.
objectMemory allHeapEntitiesDo:
[:obj| | classIdx |
classIdx := objectMemory classIndexOf: obj.
(classIdx = semaphoreClass
or: [classIdx = mutexClass]) ifTrue:
[self printProcsOnList: obj]]]
ifFalse:
[objectMemory allObjectsDoSafely:
[:obj| | classObj |
classObj := objectMemory fetchClassOfNonImm: obj.
(classObj = semaphoreClass
or: [classObj = mutexClass]) ifTrue:
[self printProcsOnList: obj]]]!
Item was changed:
----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
printMethodCacheFor: thing
<api>
0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
[:i | | s c m p |
s := methodCache at: i + MethodCacheSelector.
c := methodCache at: i + MethodCacheClass.
m := methodCache at: i + MethodCacheMethod.
p := methodCache at: i + MethodCachePrimFunction.
((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing]]]])
and: [(objectMemory addressCouldBeOop: s)
and: [c ~= 0
and: [(self addressCouldBeClassObj: c)
or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
[self cCode: [] inSmalltalk: [self transcript ensureCr].
self printNum: i; cr; tab.
(objectMemory isBytesNonImm: s)
+ ifTrue: [self cCode: 'printf("%x %.*s\n", s, numBytesOf(s), (char *)firstIndexableField(s))'
- ifTrue: [self cCode: 'printf("%x %.*s\n", s, byteLengthOf(s), (char *)firstIndexableField(s))'
inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
ifFalse: [self shortPrintOop: s].
self tab.
(self addressCouldBeClassObj: c)
ifTrue: [self shortPrintOop: c]
ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
self tab; shortPrintOop: m; tab.
self cCode:
[p > 1024
ifTrue: [self printHexnp: p]
ifFalse: [self printNum: p]]
inSmalltalk:
[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
self cr]]!
Item was changed:
----- Method: StackInterpreter>>printMethodDictionary: (in category 'debug printing') -----
printMethodDictionary: dictionary
<api>
| methodArray |
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
+ SelectorStart to: (objectMemory numSlotsOf: dictionary) - 1 do:
- SelectorStart to: (objectMemory fetchWordLengthOf: dictionary) - 1 do:
[:index | | selector meth |
selector := objectMemory fetchPointer: index ofObject: dictionary.
selector ~= objectMemory nilObject ifTrue:
[meth := objectMemory fetchPointer: index - SelectorStart ofObject: methodArray.
self
printOopShort: selector;
print: ' => ';
printOopShort: meth;
print: ' (';
printHex: selector;
print: ' => ';
printHex: meth;
putchar: $);
cr]]!
Item was changed:
----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
| cls fmt lastIndex startIP bytecodesPerLine column |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
[^self shortPrintOop: oop].
self printHex: oop.
(objectMemory addressCouldBeObj: oop) ifFalse:
[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [self whereIs: oop]); cr].
(objectMemory isFreeObject: oop) ifTrue:
[^self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr].
(objectMemory isForwarded: oop) ifTrue:
[^self
print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop); cr].
self print: ': a(n) '.
self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
cls = (objectMemory splObj: ClassFloat) ifTrue:
[^self cr; printFloat: (self dbgFloatValueOf: oop); cr].
fmt := objectMemory formatOf: oop.
fmt > objectMemory lastPointerFormat ifTrue:
+ [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)].
- [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
self print: ((self isIndirectAlien: oop)
ifTrue: [' indirect @ ']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: [' pointer @ ']
ifFalse: [' direct @ ']]).
^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
(objectMemory isWords: oop) ifTrue:
+ [lastIndex := 64 min: ((objectMemory numBytesOf: oop) / BytesPerWord).
- [lastIndex := 64 min: ((objectMemory byteLengthOf: oop) / BytesPerWord).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
^self].
^self printStringOf: oop; cr].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * BytesPerWord + 1.
lastIndex := objectMemory lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
column = 1 ifFalse:
[self cr]]!
Item was changed:
----- Method: StackInterpreter>>validInstructionPointer:inMethod:framePointer: (in category 'debug support') -----
validInstructionPointer: theInstrPointer inMethod: aMethod framePointer: fp
<var: #theInstrPointer type: #usqInt>
<var: #aMethod type: #usqInt>
<var: #fp type: #'char *'>
^self
cppIf: MULTIPLEBYTECODESETS
ifTrue:
[| methodHeader |
methodHeader := self noAssertHeaderOf: aMethod. "-1 for pre-increment in fetchNextBytecode"
theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + BytesPerOop - 1)
+ and: [theInstrPointer < (aMethod + (objectMemory numBytesOf: aMethod) + BaseHeaderSize - 1)
- and: [theInstrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + BaseHeaderSize - 1)
and: ["If the method starts with a CallPrimitive opcode the instruction pointer should be past it."
((self headerIndicatesAlternateBytecodeSet: methodHeader)
and: [(self alternateHeaderHasPrimitiveFlag: methodHeader)
and: [theInstrPointer < (aMethod
+ BytesPerOop - 1
+ (objectMemory lastPointerOf: aMethod)
+ (self sizeOfCallPrimitiveBytecode: methodHeader))]])
not]]]
ifFalse: "-1 for pre-increment in fetchNextBytecode"
[theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + BytesPerOop - 1)
+ and: [theInstrPointer < (aMethod + (objectMemory numBytesOf: aMethod) + objectMemory baseHeaderSize - 1)]]!
- and: [theInstrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + objectMemory baseHeaderSize - 1)]]!
Item was changed:
----- Method: StackInterpreter>>wakeHighestPriority (in category 'process primitive support') -----
wakeHighestPriority
"Return the highest priority process that is ready to run.
To save time looking at many empty lists before finding a
runnable process the VM maintains a variable holding the
highest priority runnable process. If this variable is 0 then the
VM does not know the highest priority and must search all lists.
Note: It is a fatal VM error if there is no runnable process."
| schedLists p processList proc ctxt |
self externalWriteBackHeadFramePointers.
schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
p := highestRunnableProcessPriority = 0
+ ifTrue: [objectMemory numSlotsOf: schedLists]
- ifTrue: [objectMemory fetchWordLengthOf: schedLists]
ifFalse: [highestRunnableProcessPriority].
[(p := p - 1) >= 0] whileTrue:
[processList := objectMemory fetchPointer: p ofObject: schedLists.
[self isEmptyList: processList] whileFalse:
["Only answer processes with a runnable suspendedContext.
Discard those that aren't; the VM would crash otherwise."
proc := self removeFirstLinkOfList: processList.
ctxt := objectMemory fetchPointer: SuspendedContextIndex ofObject: proc.
(self isLiveContext: ctxt) ifTrue:
[highestRunnableProcessPriority := p + 1.
^proc].
self warning: 'evicted zombie process from run queue']].
self error: 'scheduler could not find a runnable process'.
^nil!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
primitiveDoNamedPrimitiveWithArgs
"Simulate an primitiveExternalCall invocation (e.g. for the Debugger). Do not cache anything.
e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
| argumentArray arraySize methodArg methodHeader
moduleName functionName moduleLength functionLength
spec addr primRcvr ctxtRcvr isArray |
<var: #addr declareC: 'void (*addr)()'>
argumentArray := self stackTop.
methodArg := self stackValue: 2.
((objectMemory isArray: argumentArray)
and: [objectMemory isOopCompiledMethod: methodArg]) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
+ arraySize := objectMemory numSlotsOf: argumentArray.
- arraySize := objectMemory fetchWordLengthOf: argumentArray.
(self roomToPushNArgs: arraySize) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
methodHeader := self headerOf: methodArg.
(self literalCountOfHeader: methodHeader) > 2 ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
isArray := self isInstanceOfClassArray: spec.
(isArray
and: [(objectMemory lengthOf: spec) = 4
and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = 117]]) ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
"The function has not been loaded yet. Fetch module and function name."
moduleName := objectMemory fetchPointer: 0 ofObject: spec.
moduleName = objectMemory nilObject
ifTrue: [moduleLength := 0]
ifFalse: [self success: (objectMemory isBytes: moduleName).
moduleLength := objectMemory lengthOf: moduleName.
self cCode: '' inSmalltalk:
[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
ifTrue: [moduleLength := 0 "Cause all of these to fail"]]].
functionName := objectMemory fetchPointer: 1 ofObject: spec.
self success: (objectMemory isBytes: functionName).
functionLength := objectMemory lengthOf: functionName.
self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
OfLength: functionLength
FromModule: moduleName + BaseHeaderSize
OfLength: moduleLength.
addr = 0 ifTrue:
[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
"Cannot fail this primitive from now on. Can only fail the external primitive."
objectMemory pushRemappableOop: (argumentArray := self popStack).
objectMemory pushRemappableOop: (primRcvr := self popStack).
objectMemory pushRemappableOop: self popStack. "the method"
objectMemory pushRemappableOop: self popStack. "the context receiver"
self push: primRcvr. "replace context receiver with actual receiver"
argumentCount := arraySize.
1 to: arraySize do:
[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
self callExternalPrimitive: addr.
ctxtRcvr := objectMemory popRemappableOop.
methodArg := objectMemory popRemappableOop.
primRcvr := objectMemory popRemappableOop.
argumentArray := objectMemory popRemappableOop.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[self pop: arraySize + 1.
self push: ctxtRcvr.
self push: methodArg.
self push: primRcvr.
self push: argumentArray.
argumentCount := 3.
"Hack. A nil prim error code (primErrorCode = 1) is interpreted by the image
as meaning this primitive is not implemented. So to pass back nil as an error
code we use -1 to indicate generic failure."
primFailCode = 1 ifTrue:
[primFailCode := -1]]!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
primitiveDoPrimitiveWithArgs
| argumentArray arraySize index primIdx |
argumentArray := self stackTop.
(objectMemory isArray: argumentArray) ifFalse: [^self primitiveFail].
+ arraySize := objectMemory numSlotsOf: argumentArray.
- arraySize := objectMemory fetchWordLengthOf: argumentArray.
self success: (self roomToPushNArgs: arraySize).
primIdx := self stackIntegerValue: 1.
self successful ifFalse: [^self primitiveFail]. "invalid args"
primitiveFunctionPointer := self functionPointerFor: primIdx inClass: nil.
primitiveFunctionPointer = 0 ifTrue:
[^self primitiveFail].
"Pop primIndex and argArray, then push args in place..."
self pop: 2.
argumentCount := arraySize.
index := 1.
[index <= argumentCount] whileTrue:
[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
self isPrimitiveFunctionPointerAnIndex ifTrue:
[self externalQuickPrimitiveResponse.
^nil].
"We use tempOop instead of pushRemappableOop:/popRemappableOop here because in
the Cogit primitiveEnterCriticalSection, primitiveSignal, primitiveResume et al longjmp back
to either the interpreter or machine code, depending on the process activated. So if we're
executing one of these primitives control won't actually return here and the matching
popRemappableOop: wouldn't occur, potentially overflowing the remap buffer. While recursion
could occur (nil tryPrimitive: 118 withArgs: #(111 #())) it counts as shooting oneself in the foot."
tempOop := argumentArray. "prim might alloc/gc"
"Run the primitive (sets primFailCode)"
self slowPrimitiveResponse.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[self pop: arraySize.
self pushInteger: primIdx.
self push: tempOop.
argumentCount := 2].
tempOop := 0!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
primitiveExecuteMethodArgsArray
"receiver, argsArray, then method are on top of stack. Execute method against
receiver and args. Allow for up to two extra arguments (e.g. for mirror primitives).
Set primitiveFunctionPointer because no cache lookup has been done for the
method, and hence primitiveFunctionPointer is stale."
| methodArgument argCnt argumentArray primitiveIndex |
methodArgument := self stackTop.
argumentArray := self stackValue: 1.
((objectMemory isOopCompiledMethod: methodArgument)
and: [objectMemory isArray: argumentArray]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
argCnt := self argumentCountOf: methodArgument.
+ argCnt = (objectMemory numSlotsOf: argumentArray) ifFalse:
- argCnt = (objectMemory fetchWordLengthOf: argumentArray) ifFalse:
[^self primitiveFailFor: PrimErrBadNumArgs].
argumentCount > 2 ifTrue: "CompiledMethod class>>receiver:withArguments:executeMethod:
SqueakObjectPrimitives class >> receiver:withArguments:apply:
VMMirror>>ifFail:object:with:executeMethod: et al"
[argumentCount > 4 ifTrue:
[^self primitiveFailFor: PrimErrUnsupported].
self stackValue: argumentCount put: (self stackValue: 2)]. "replace actual receiver with desired receiver"
"and push the actual arguments"
self pop: argumentCount.
0 to: argCnt - 1 do:
[:i|
self push: (objectMemory fetchPointer: i ofObject: argumentArray)].
newMethod := methodArgument.
primitiveIndex := self primitiveIndexOf: newMethod.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: nil.
argumentCount := argCnt.
self executeNewMethod.
"Recursive xeq affects primErrorCode"
self initPrimCall!
Item was changed:
----- Method: StackInterpreterSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
classAndSelectorOfMethod: meth forReceiver: rcvr
| mClass dict length methodArray |
mClass := objectMemory fetchClassOf: rcvr.
[dict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: mClass.
+ length := objectMemory numSlotsOf: dict.
- length := objectMemory fetchWordLengthOf: dict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dict.
0 to: length-SelectorStart-1 do:
[:index |
meth = (objectMemory fetchPointer: index ofObject: methodArray)
ifTrue: [^ Array
with: mClass
with: (objectMemory fetchPointer: index + SelectorStart ofObject: dict)]].
mClass := self superclassOf: mClass.
mClass = objectMemory nilObject]
whileFalse.
^ Array
with: (objectMemory fetchClassOf: rcvr)
with: (objectMemory splObj: SelectorDoesNotUnderstand)!
Item was added:
+ ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
+ initializeBytecodeTableForSistaV1
+ "StackToRegisterMappingCogit initializeBytecodeTableForSistaV1"
+
+ isPushNilFunction := #sistaV1:Is:Push:Nil:.
+ pushNilSizeFunction := #sistaV1PushNilSize:.
+ self flag:
+ 'Special selector send class must be inlined to agree with the interpreter, which
+ inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
+ class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
+ have identical semantics. We get away with not hardwiring the other special
+ selectors either because in the Cointerpreter they are not inlined or because they
+ are inlined only to instances of classes for which there will always be a method.'.
+ self generatorTableFrom: #(
+ "1 byte bytecodes"
+ "pushes"
+ (1 0 15 genPushReceiverVariableBytecode needsFrameNever: 1)
+ (1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
+ (1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
+ (1 64 75 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
+ (1 76 76 genPushReceiverBytecode needsFrameNever: 1)
+ (1 77 77 pushConstantTrueBytecode needsFrameNever: 1)
+ (1 78 78 pushConstantFalseBytecode needsFrameNever: 1)
+ (1 79 79 pushConstantNilBytecode needsFrameNever: 1)
+ (1 80 80 genPushConstantZeroBytecode needsFrameNever: 1)
+ (1 81 81 genPushConstantOneBytecode needsFrameNever: 1)
+ (1 82 82 genExtPushPseudoVariable)
+ (1 83 83 duplicateTopBytecode needsFrameNever: 1)
+
+ (1 84 87 unknownBytecode)
+
+ "returns"
+ (1 88 88 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
+ (1 89 89 genReturnTrue return needsFrameIfInBlock: isMappedInBlock 0)
+ (1 90 90 genReturnFalse return needsFrameIfInBlock: isMappedInBlock 0)
+ (1 91 91 genReturnNil return needsFrameIfInBlock: isMappedInBlock 0)
+ (1 92 92 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
+ (1 93 93 genReturnNilFromBlock return needsFrameNever: -1)
+ (1 94 94 genReturnTopFromBlock return needsFrameNever: -1)
+ (1 95 95 genExtNop needsFrameNever: 0)
+
+ "sends"
+ (1 96 96 genSpecialSelectorArithmetic isMapped AddRR)
+ (1 97 97 genSpecialSelectorArithmetic isMapped SubRR)
+ (1 98 98 genSpecialSelectorComparison isMapped JumpLess)
+ (1 99 99 genSpecialSelectorComparison isMapped JumpGreater)
+ (1 100 100 genSpecialSelectorComparison isMapped JumpLessOrEqual)
+ (1 101 101 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
+ (1 102 102 genSpecialSelectorComparison isMapped JumpZero)
+ (1 103 103 genSpecialSelectorComparison isMapped JumpNonZero)
+ (1 104 109 genSpecialSelectorSend isMapped) " #* #/ #\\ #@ #bitShift: //"
+ (1 110 110 genSpecialSelectorArithmetic isMapped AndRR)
+ (1 111 111 genSpecialSelectorArithmetic isMapped OrRR)
+ (1 112 117 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
+ (1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
+ (1 119 119 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
+ (1 120 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
+
+ (1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
+ (1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
+ (1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
+
+ "jumps"
+ (1 176 183 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
+ (1 184 191 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
+ v3:ShortForward:Branch:Distance:)
+ (1 192 199 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
+ v3:ShortForward:Branch:Distance:)
+
+ "stores"
+ (1 200 207 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
+ (1 208 215 genStoreAndPopTemporaryVariableBytecode)
+
+ (1 216 216 genPopStackBytecode needsFrameNever: -1)
+
+ (1 217 223 unknownBytecode)
+
+ "2 byte bytecodes"
+ (2 224 224 extABytecode extension)
+ (2 225 225 extBBytecode extension)
+
+ "pushes"
+ (2 226 226 genExtPushReceiverVariableBytecode needsFrameNever: 1)
+ (2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1)
+ (2 228 228 genExtPushLiteralBytecode needsFrameNever: 1)
+ (2 229 229 genLongPushTemporaryVariableBytecode)
+ (2 230 230 genPushClosureTempsBytecode)
+ (2 231 231 genPushNewArrayBytecode)
+ (2 232 232 genExtPushIntegerBytecode needsFrameNever: 1)
+ (2 233 233 genExtPushCharacterBytecode needsFrameNever: 1)
+
+ "returns"
+ "sends"
+ (2 234 234 genExtSendBytecode isMapped)
+ (2 235 235 genExtSendSuperBytecode isMapped)
+
+ "sista bytecodes"
+ (2 236 236 genExtTrapIfNotInstanceOfBehaviorsBytecode isMapped)
+
+ "jumps"
+ (2 237 237 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
+ (2 238 238 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
+ (2 239 239 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
+
+ "stores"
+ (2 240 240 genExtStoreAndPopReceiverVariableBytecode)
+ (2 241 241 genExtStoreAndPopLiteralVariableBytecode)
+ (2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
+ (2 243 243 genExtStoreReceiverVariableBytecode)
+ (2 244 244 genExtStoreLiteralVariableBytecode)
+ (2 245 245 genLongStoreTemporaryVariableBytecode)
+
+ (2 246 247 unknownBytecode)
+
+ "3 byte bytecodes"
+ (3 248 248 callPrimitiveBytecode)
+ (3 249 249 unknownBytecode) "reserved for Push Float"
+ (3 250 250 genExtPushClosureBytecode block sistaV1:Block:Code:Size:)
+ (3 251 251 genPushRemoteTempLongBytecode)
+ (3 252 252 genStoreRemoteTempLongBytecode)
+ (3 253 253 genStoreAndPopRemoteTempLongBytecode)
+
+ (3 254 255 unknownBytecode))!
Item was changed:
SharedPool subclass: #VMBasicConstants
instanceVariableNames: ''
+ classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr GCModeScavenge IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr STACKVM ShiftForWord SistaVM VMBIGENDIAN'
- classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr GCModeScavenge IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr STACKVM ShiftForWord VMBIGENDIAN'
poolDictionaries: ''
category: 'VMMaker-Interpreter'!
!VMBasicConstants commentStamp: '<historical>' prior: 0!
I am a shared pool for basic constants upon which the VM as a whole depends.
self ensureClassPool.
self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
(ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
[:k| self classPool declare: k from: ObjectMemory classPool]!
Item was changed:
----- Method: VMClass class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants
"Falsify the `what type of VM is this?' flags that are defined in the various interp.h files,
or in the case of VMBIGENDIAN the various sqConfig.h files.
Subclass implementations need to include a super initializeMiscConstants"
| omc |
VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
self isInterpreterClass ifTrue:
[STACKVM := COGVM := COGMTVM := false].
initializationOptions ifNil: [self initializationOptions: Dictionary new].
omc := initializationOptions at: #ObjectMemory ifAbsent: nil.
initializationOptions
at: #SqueakV3ObjectMemory "the good ole default"
put: (omc
ifNil: [true]
ifNotNil: [(Smalltalk at: omc) inheritsFrom: ObjectMemory]);
at: #SpurObjectMemory "the new condender"
put: (omc
ifNil: [false]
ifNotNil: [(Smalltalk at: omc) inheritsFrom: SpurMemoryManager]).
"Use ifAbsentPut: so that they will get copied back to the
VMMaker's options and dead code will likely be eliminated."
NewspeakVM := initializationOptions at: #NewspeakVM ifAbsentPut: [false].
+ SistaVM := initializationOptions at: #SistaVM ifAbsentPut: [false].
MULTIPLEBYTECODESETS := initializationOptions at: #MULTIPLEBYTECODESETS ifAbsentPut: [false].
"N.B. Not yet implemented."
IMMUTABILITY := initializationOptions at: #IMMUTABILITY ifAbsentPut: [false].
"These for scripts etc... Usually they should get set by an Interpreter class's initializeMiscConstantsWith:"
(initializationOptions includesKey: #STACKVM) ifTrue:
[STACKVM := initializationOptions at: #STACKVM].
(initializationOptions includesKey: #COGVM) ifTrue:
[COGVM := initializationOptions at: #COGVM].
(initializationOptions includesKey: #COGMTVM) ifTrue:
[COGMTVM := initializationOptions at: #COGMTVM]!
Item was changed:
----- Method: VMCompiledMethodProxy>>at: (in category 'accessing') -----
at: index
+ ^(index between: 1 and: (objectMemory numBytesOf: oop))
- ^(index between: 1 and: (objectMemory byteLengthOf: oop))
ifTrue: [objectMemory fetchByte: index - 1 ofObject: oop]
ifFalse: [self errorSubscriptBounds: index]!
Item was changed:
----- Method: VMCompiledMethodProxy>>size (in category 'accessing') -----
size
+ ^objectMemory numBytesOf: oop!
- ^objectMemory byteLengthOf: oop!
Item was changed:
----- Method: VMMaker class>>generateSqueakCogSistaVM (in category 'configurations') -----
generateSqueakCogSistaVM
"No primitives since we can use those for the Cog VM"
^VMMaker
generate: CoInterpreter
and: SistaStackToRegisterMappingCogit
+ with: #( SistaVM true
+ MULTIPLEBYTECODESETS true
- with: #( MULTIPLEBYTECODESETS true
bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
to: (FileDirectory default pathFromURI: self sourceTree, '/sistasrc')
platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
including: #()!
Item was changed:
----- Method: VMMaker class>>generateSqueakSpurCogSistaVM (in category 'configurations') -----
generateSqueakSpurCogSistaVM
"No primitives since we can use those for the Cog VM"
^VMMaker
generate: CoInterpreter
and: SistaStackToRegisterMappingCogit
+ with: #( SistaVM true
+ ObjectMemory Spur32BitCoMemoryManager
- with: #( ObjectMemory Spur32BitCoMemoryManager
MULTIPLEBYTECODESETS true
bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
to: (FileDirectory default pathFromURI: self sourceTree, '/spursistasrc')
platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
including:#()!
1
0
Eliot Miranda uploaded a new version of BytecodeSets to project VM Maker:
http://source.squeak.org/VMMaker/BytecodeSets-eem.5.mcz
==================== Summary ====================
Name: BytecodeSets-eem.5
Author: eem
Time: 28 July 2014, 6:51:38.277 pm
UUID: 80859714-b8e4-4799-8eec-5df0c9eef0cb
Ancestors: BytecodeSets-eem.4
Change the inline rem: prim to an inline quo: prim,. There is no
proimitive support for rem: but quo: is expected. We can
always add rem: later.
=============== Diff against BytecodeSets-eem.4 ===============
Item was changed:
BytecodeEncoder subclass: #EncoderForSistaV1
(excessive size, no diff calculated)
1
0
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.174.mcz
==================== Summary ====================
Name: Cog-eem.174
Author: eem
Time: 28 July 2014, 6:38:12.482 pm
UUID: 8d96136f-1223-476e-9761-546dd9e1d66c
Ancestors: Cog-eem.173
Use numSlotsOf: and numBytesOf: in place of
fetchLong32LengthOf:, fetchWordLengthOf: and byteLengthOf:.
Needs VMMaker.oscog-eem.837
=============== Diff against Cog-eem.173 ===============
Item was changed:
----- Method: SpurBootstrap>>clone:classIndex: (in category 'bootstrap image') -----
clone: oldObj classIndex: classIndex
| newObj |
newObj := newHeap
+ allocateSlots: (oldHeap numSlotsOf: oldObj)
- allocateSlots: (oldHeap fetchWordLengthOf: oldObj)
format: (self newFormatFor: oldObj)
classIndex: classIndex.
reverseMap at: newObj put: oldObj.
^map at: oldObj put: newObj!
Item was changed:
----- Method: SpurBootstrap>>findLiteral: (in category 'bootstrap methods') -----
findLiteral: aLiteral
| symbolOop smalltalk array |
aLiteral isString ifTrue:
[^self stringFor: aLiteral].
aLiteral isFloat ifTrue:
[^oldInterpreter floatObjectOf: aLiteral].
aLiteral isArray ifTrue:
[^self cloneArrayLiteral: aLiteral].
self assert: aLiteral isVariableBinding.
symbolOop := self findSymbol: aLiteral key.
smalltalk := oldHeap splObj: 8.
array := oldHeap fetchPointer: 1 ofObject: smalltalk.
self assert: (oldHeap isArray: array).
+ 0 to: (oldHeap numSlotsOf: array) - 1 do:
- 0 to: (oldHeap fetchWordLengthOf: array) - 1 do:
[:i| | bindingOrNil |
bindingOrNil := oldHeap fetchPointer: i ofObject: array.
(bindingOrNil ~= oldHeap nilObject
and: [symbolOop = (oldHeap fetchPointer: KeyIndex ofObject: bindingOrNil)
and: [aLiteral key == #Smalltalk
ifTrue:
[(oldHeap fetchPointer: ValueIndex ofObject: bindingOrNil) = smalltalk]
ifFalse:
[oldInterpreter
classNameOf: (oldHeap fetchPointer: ValueIndex ofObject: bindingOrNil)
Is: aLiteral key]]]) ifTrue:
[^bindingOrNil]].
self error: 'couldn''t find literal ', aLiteral printString!
Item was changed:
----- Method: SpurBootstrap>>findSymbol: (in category 'bootstrap methods') -----
findSymbol: aString
"Find the Symbol equal to aString in oldHeap."
| symbolClass |
(literalMap at: aString ifAbsent: nil) ifNotNil:
[:oop| ^oop].
symbolClass := self symbolClass.
oldHeap allObjectsDo:
[:obj|
(symbolClass = (oldHeap fetchClassOfNonImm: obj)
+ and: [(oldHeap numBytesOf: obj) = aString size
- and: [(oldHeap byteLengthOf: obj) = aString size
and: [aString = (oldHeap stringOf: obj)]]) ifTrue:
[^obj]].
^nil!
Item was changed:
----- Method: SpurBootstrap>>indexOfSelector:in: (in category 'bootstrap methods') -----
indexOfSelector: selectorOop in: methodDict
+ SelectorStart to: (oldHeap numSlotsOf: methodDict) - 1 do:
- SelectorStart to: (oldHeap fetchWordLengthOf: methodDict) - 1 do:
[:i|
(oldHeap fetchPointer: i ofObject: methodDict) = selectorOop ifTrue:
[^i]].
self error: 'could not find selector in method dict'!
Item was changed:
----- Method: SpurBootstrap>>modifyCharacterMethods (in category 'bootstrap methods') -----
modifyCharacterMethods
| cc md mda |
cc := oldHeap classCharacter.
md := oldHeap fetchPointer: MethodDictionaryIndex ofObject: cc.
mda := oldHeap fetchPointer: MethodArrayIndex ofObject: md..
+ 0 to: (oldHeap numSlotsOf: mda) - 1 do:
- 0 to: (oldHeap fetchWordLengthOf: mda) - 1 do:
[:i| | method |
method := oldHeap fetchPointer: i ofObject: mda.
method ~= oldHeap nilObject ifTrue:
[(self replacementForCharacterMethod: method) ifNotNil:
[:replacement|
Transcript
cr;
nextPutAll: 'replacing Character>>#';
nextPutAll: (oldHeap stringOf: (oldHeap fetchPointer: i + SelectorStart ofObject: md));
flush.
oldHeap
storePointer: i
ofObject: mda
withValue: replacement]]]!
Item was changed:
----- Method: SpurBootstrap>>newFormatFor: (in category 'bootstrap image') -----
newFormatFor: oldObj
"OLD:
0 no fields
1 fixed fields only (all containing pointers)
2 indexable fields only (all containing pointers)
3 both fixed and indexable fields (all containing pointers)
4 both fixed and indexable weak fields (all containing pointers).
5 unused
6 indexable word fields only (no pointers)
7 indexable long (64-bit) fields (only in 64-bit images)
8-11 indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
12-15 compiled methods:
# of literal oops specified in method header,
followed by indexable bytes (same interpretation of low 2 bits as above)"
"NEW:
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
and here it gets messy, we need 8 CompiledMethod values, 8 byte values, 4 16-bit values, 2 32-bit values and a 64-bit value, = 23 values, 23 + 5 = 30, so there may be room.
9 (?) 64-bit indexable
10 - 11 32-bit indexable
12 - 15 16-bit indexable
16 - 23 byte indexable
24 - 31 compiled method"
| oldFormat |
oldFormat := oldHeap formatOf: oldObj.
oldFormat <= 4 ifTrue:
[^oldFormat].
oldFormat >= 12 ifTrue: "CompiledMethod"
+ [^24 + (self wordSize - (oldHeap numBytesOf: oldObj) bitAnd: self wordSizeMask)].
- [^24 + (self wordSize - (oldHeap byteLengthOf: oldObj) bitAnd: self wordSizeMask)].
oldFormat >= 8 ifTrue: "ByteArray et al"
+ [^16 + (self wordSize - (oldHeap numBytesOf: oldObj) bitAnd: self wordSizeMask)].
- [^16 + (self wordSize - (oldHeap byteLengthOf: oldObj) bitAnd: self wordSizeMask)].
oldFormat = 6 ifTrue: "32-bit indexable"
+ [^10 + ((oldHeap numBytesOf: oldObj) bitAnd: self wordSizeMask) sign].
- [^10 + ((oldHeap byteLengthOf: oldObj) bitAnd: self wordSizeMask) sign].
oldFormat = 7 ifTrue: "64-bit indexable"
[^9].
self error: 'illegal old format'!
Item was changed:
----- Method: SpurBootstrap32>>fillInBitsObject:from: (in category 'bootstrap') -----
fillInBitsObject: newObj from: oldObj
+ 0 to: (oldHeap numSlotsOf: oldObj) - 1 do:
- 0 to: (oldHeap fetchLong32LengthOf: oldObj) - 1 do:
[:i|
newHeap
storeLong32: i
ofObject: newObj
withValue: (oldHeap fetchLong32: i ofObject: oldObj)]!
1
0
3
9
Eliot Miranda uploaded a new version of BytecodeSets to project VM Maker:
http://source.squeak.org/VMMaker/BytecodeSets-eem.4.mcz
==================== Summary ====================
Name: BytecodeSets-eem.4
Author: eem
Time: 27 July 2014, 6:54:11.684 pm
UUID: 7db73403-61ca-43c9-8a7b-ff758a61cec2
Ancestors: BytecodeSets-eem.3
Fix a few slips in the SistaV1 definition in EncoderForSistaV1's
class comment.
=============== Diff against BytecodeSets-eem.3 ===============
Item was changed:
BytecodeEncoder subclass: #EncoderForSistaV1
(excessive size, no diff calculated)
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.836.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.836
Author: eem
Time: 26 July 2014, 10:33:36.137 pm
UUID: f3944e9a-5f99-44d8-8318-4407e42deaa6
Ancestors: VMMaker.oscog-eem.835
Define SimpleStackBasedCogit's SistaV1 bytecode table.
Correct a comment typo in ints NewspeakV4 table.
=============== Diff against VMMaker.oscog-eem.835 ===============
Item was changed:
----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') -----
initializeBytecodeTableForNewspeakV4
"SimpleStackBasedCogit initializeBytecodeTableForNewspeakV4"
NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit"
self flag:
'Special selector send class must be inlined to agree with the interpreter, which
inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
have identical semantics. We get away with not hardwiring the other special
selectors either because in the Cointerpreter they are not inlined or because they
are inlined only to instances of classes for which there will always be a method.'.
self generatorTableFrom: #(
"1 byte bytecodes"
(1 0 15 genPushReceiverVariableBytecode)
(1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
(1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
(1 64 75 genPushTemporaryVariableBytecode)
(1 76 76 genPushReceiverBytecode)
(1 77 77 genExtPushPseudoVariableOrOuterBytecode)
(1 78 78 genPushConstantZeroBytecode)
(1 79 79 genPushConstantOneBytecode)
+ (1 80 101 genSpecialSelectorSend isMapped) "#+ #- #< #> #<= #>= #= #~= #* #/ #\\ #@ #bitShift: #// #bitAnd: #bitOr: #at: #at:put: #size #next #nextPut: #atEnd"
- (1 80 101 genSpecialSelectorSend isMapped) "#+ #- #< #> #<= #>= #= #~= #at: #at:put: #size #next #nextPut: #atEnd"
(1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
(1 103 103 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)"
(1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
(1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
(1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
(1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
(1 160 175 genSendAbsentImplicit0ArgsBytecode isMapped hasIRC)
(1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
(1 184 191 genStoreAndPopTemporaryVariableBytecode)
(1 192 199 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
(1 200 207 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(1 208 215 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
v3:ShortForward:Branch:Distance:)
(1 216 216 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
(1 217 217 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
(1 218 218 genExtReturnTopFromBlock return needsFrameNever: -1)
(1 219 219 duplicateTopBytecode needsFrameNever: 1)
(1 220 220 genPopStackBytecode needsFrameNever: -1)
(1 221 221 genExtNopBytecode needsFrameNever: 0)
(1 222 223 unknownBytecode)
"2 byte bytecodes"
(2 224 224 extABytecode extension)
(2 225 225 extBBytecode extension)
(2 226 226 genExtPushReceiverVariableBytecode)
(2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1)
(2 228 228 genExtPushLiteralBytecode needsFrameNever: 1)
(2 229 229 genExtPushIntegerBytecode needsFrameNever: 1)
(2 230 230 genLongPushTemporaryVariableBytecode)
(2 231 231 genPushNewArrayBytecode)
(2 232 232 genExtStoreReceiverVariableBytecode)
(2 233 233 genExtStoreLiteralVariableBytecode)
(2 234 234 genLongStoreTemporaryVariableBytecode)
(2 235 235 genExtStoreAndPopReceiverVariableBytecode)
(2 236 236 genExtStoreAndPopLiteralVariableBytecode)
(2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
(2 238 238 genExtSendBytecode isMapped)
(2 239 239 genExtSendSuperBytecode isMapped)
(2 240 240 genExtSendAbsentImplicitBytecode isMapped hasIRC)
(2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped)
(2 242 242 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
(2 243 243 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
(2 244 244 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
(2 245 248 unknownBytecode)
"3 byte bytecodes"
(3 249 249 callPrimitiveBytecode)
(3 250 250 genPushRemoteTempLongBytecode)
(3 251 251 genStoreRemoteTempLongBytecode)
(3 252 252 genStoreAndPopRemoteTempLongBytecode)
(3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:)
(3 254 255 unknownBytecode))!
Item was added:
+ ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
+ initializeBytecodeTableForSistaV1
+ "SimpleStackBasedCogit initializeBytecodeTableForSistaV1"
+
+ self flag:
+ 'Special selector send class must be inlined to agree with the interpreter, which
+ inlines class. If class is sent to e.g. a general instance of ProtoObject then unless
+ class is inlined there will be an MNU. It must be that the Cointerpreter and Cogit
+ have identical semantics. We get away with not hardwiring the other special
+ selectors either because in the Cointerpreter they are not inlined or because they
+ are inlined only to instances of classes for which there will always be a method.'.
+ self generatorTableFrom: #(
+ "1 byte bytecodes"
+ "pushes"
+ (1 0 15 genPushReceiverVariableBytecode)
+ (1 16 31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
+ (1 32 63 genPushLiteralConstantBytecode needsFrameNever: 1)
+ (1 64 75 genPushTemporaryVariableBytecode)
+ (1 76 76 genPushReceiverBytecode)
+ (1 77 77 pushConstantTrueBytecode needsFrameNever: 1)
+ (1 78 78 pushConstantFalseBytecode needsFrameNever: 1)
+ (1 79 79 pushConstantNilBytecode needsFrameNever: 1)
+ (1 80 80 genPushConstantZeroBytecode needsFrameNever: 1)
+ (1 81 81 genPushConstantOneBytecode needsFrameNever: 1)
+ (1 82 82 genExtPushPseudoVariable)
+ (1 83 83 duplicateTopBytecode needsFrameNever: 1)
+
+ (1 84 87 unknownBytecode)
+
+ "returns"
+ (1 88 88 genReturnReceiver return needsFrameIfInBlock: isMappedInBlock 0)
+ (1 89 89 genReturnTrue return needsFrameIfInBlock: isMappedInBlock 0)
+ (1 90 90 genReturnFalse return needsFrameIfInBlock: isMappedInBlock 0)
+ (1 91 91 genReturnNil return needsFrameIfInBlock: isMappedInBlock 0)
+ (1 92 92 genReturnTopFromMethod return needsFrameIfInBlock: isMappedInBlock -1)
+ (1 93 93 genReturnNilFromBlock return needsFrameNever: -1)
+ (1 94 94 genReturnTopFromBlock return needsFrameNever: -1)
+ (1 95 95 genExtNop needsFrameNever: 0)
+
+ "sends"
+ (1 96 117 genSpecialSelectorSend isMapped) "#+ #- #< #> #<= #>= #= #~= #* #/ #\\ #@ #bitShift: #// #bitAnd: #bitOr: #at: #at:put: #size #next #nextPut: #atEnd"
+ (1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
+ (1 119 119 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)"
+ (1 120 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
+
+ (1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
+ (1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
+ (1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
+
+ "jumps"
+ (1 176 183 genShortUnconditionalJump branch v3:ShortForward:Branch:Distance:)
+ (1 184 191 genShortJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean"
+ v3:ShortForward:Branch:Distance:)
+ (1 192 199 genShortJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean"
+ v3:ShortForward:Branch:Distance:)
+
+ "stores"
+ (1 200 207 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
+ (1 208 215 genStoreAndPopTemporaryVariableBytecode)
+
+ (1 216 216 genPopStackBytecode needsFrameNever: -1)
+
+ (1 217 223 unknownBytecode)
+
+ "2 byte bytecodes"
+ (2 224 224 extABytecode extension)
+ (2 225 225 extBBytecode extension)
+
+ "pushes"
+ (2 226 226 genExtPushReceiverVariableBytecode)
+ (2 227 227 genExtPushLiteralVariableBytecode needsFrameNever: 1)
+ (2 228 228 genExtPushLiteralBytecode needsFrameNever: 1)
+ (2 229 229 genLongPushTemporaryVariableBytecode)
+ (2 230 230 genPushClosureTempsBytecode)
+ (2 231 231 genPushNewArrayBytecode)
+ (2 232 232 genExtPushIntegerBytecode needsFrameNever: 1)
+ (2 233 233 genExtPushCharacterBytecode needsFrameNever: 1)
+
+ "returns"
+ "sends"
+ (2 234 234 genExtSendBytecode isMapped)
+ (2 235 235 genExtSendSuperBytecode isMapped)
+
+ "sista bytecodes"
+ (2 236 236 genExtTrapIfNotInstanceOfBehaviorsBytecode isMapped)
+
+ "jumps"
+ (2 237 237 genExtUnconditionalJump branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
+ (2 238 238 genExtJumpIfTrue branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
+ (2 239 239 genExtJumpIfFalse branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
+
+ "stores"
+ (2 240 240 genExtStoreAndPopReceiverVariableBytecode)
+ (2 241 241 genExtStoreAndPopLiteralVariableBytecode)
+ (2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
+ (2 243 243 genExtStoreReceiverVariableBytecode)
+ (2 244 244 genExtStoreLiteralVariableBytecode)
+ (2 245 245 genLongStoreTemporaryVariableBytecode)
+
+ (2 246 247 unknownBytecode)
+
+ "3 byte bytecodes"
+ (3 248 248 callPrimitiveBytecode)
+ (3 249 249 unknownBytecode) "reserved for Push Float"
+ (3 250 250 genExtPushClosureBytecode block sistaV1:Block:Code:Size:)
+ (3 251 251 genPushRemoteTempLongBytecode)
+ (3 252 252 genStoreRemoteTempLongBytecode)
+ (3 253 253 genStoreAndPopRemoteTempLongBytecode)
+
+ (3 254 255 unknownBytecode))!
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.835.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.835
Author: eem
Time: 26 July 2014, 7:59:57.815 am
UUID: 4bf1a46a-22b3-4062-aafa-acba4fd5177a
Ancestors: VMMaker.oscog-eem.834
Sista:
Implement extTrapIfNotInstanceOfBehaviorsBytecode.
Needs fixes to inlining below.
Fix slip in CoInterpreter>>ceCounterTripped: that would
break Spur (classForClassTag: instead of classTagForClass:).
Slang:
Fix inlining of shared case code for cases where control
does flow through to the end of the bytecode (i.e.
extTrapIfNotInstanceOfBehaviorsBytecode).
Simplify the shared code pragma allowing simply
<sharedCodeInCase: #destinationSelector>
=============== Diff against VMMaker.oscog-eem.834 ===============
Item was changed:
----- Method: CoInterpreter>>ceCounterTripped: (in category 'cog jit support') -----
ceCounterTripped: condition
"Two things are going on here. The main one is catching a counter trip and attempting
to send the SelectorCounterTripped selector. In this case we would like to back-up
the pc to the return address of the send that yields the boolean to be tested, so that
after potential optimization, computation proceeds by retrying the jump. But we cannot,
since there may be no send, just a pop (as in and: [] and or: [] chains). In this case we also
want to prevent further callbacks until optimization is complete. So we nil-out the
SelectorCounterTripped entry in the specialSelectorArray.
The minor case is that there is an unlikely possibility that the cointer tripped but condition
is not a boolean, in which case a mustBeBoolean response should occur."
<api>
<option: #SistaStackToRegisterMappingCogit>
"Send e.g. thisContext conditionalBranchCounterTrippedOn: boolean."
| context counterTrippedSelector classTag |
(condition = objectMemory falseObject
or: [condition = objectMemory trueObject]) ifFalse:
[^self ceSendMustBeBoolean: condition].
counterTrippedSelector := objectMemory maybeSplObj: SelectorCounterTripped.
(counterTrippedSelector isNil
or: [counterTrippedSelector = objectMemory nilObject]) ifTrue:
[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
^condition].
classTag := objectMemory
classTagForSpecialObjectsIndex: ClassMethodContext
compactClassIndex: ClassMethodContextCompactIndex.
(self lookupInMethodCacheSel: counterTrippedSelector classTag: classTag) ifFalse:
[messageSelector := counterTrippedSelector.
+ (self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
- (self lookupMethodNoMNUEtcInClass: (objectMemory classTagForClass: classTag)) ~= 0 ifTrue:
[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
^condition]].
(primitiveFunctionPointer ~= 0
or: [(self argumentCountOf: newMethod) ~= 1]) ifTrue:
[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
^condition].
objectMemory splObj: SelectorCounterTripped put: objectMemory nilObject.
instructionPointer := self popStack.
context := self ensureFrameIsMarried: framePointer SP: stackPointer.
self push: context.
self push: condition.
self ifAppropriateCompileToNativeCode: newMethod selector: counterTrippedSelector.
self activateNewMethod.
"not reached"
^true!
Item was added:
+ ----- Method: NewObjectMemory>>rawClassTagForClass: (in category 'interpreter access') -----
+ rawClassTagForClass: classObj
+ "Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
+ classTag in the first-level method cache and a class itself."
+ ^classObj!
Item was added:
+ ----- Method: ObjectMemory>>is:instanceOf: (in category 'header access') -----
+ is: oop instanceOf: classOop
+ "Answer if oop is an instance of the given class. If the class has a (non-zero)
+ compactClassIndex use that to speed up the check."
+
+ <inline: true>
+ (self isIntegerObject: oop) ifTrue:
+ [^classOop = (self splObj: ClassSmallInteger)].
+
+ ^self isClassOfNonImm: oop equalTo: classOop!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>fetchClassTagOf: (in category 'interpreter access') -----
+ fetchClassTagOf: oop
+ | tagBits |
+ (tagBits := oop bitAnd: self tagMask) ~= 0 ifTrue:
+ [^(tagBits bitAnd: 1) ~= 0 ifTrue: [1] ifFalse: [tagBits]].
+ ^self classIndexOf: oop!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>fetchClassTagOf: (in category 'interpreter access') -----
+ fetchClassTagOf: oop
+ | tagBits |
+ ^(tagBits := oop bitAnd: self tagMask) ~= 0
+ ifTrue: [tagBits]
+ ifFalse: [self classIndexOf: oop]!
Item was changed:
----- Method: SpurMemoryManager>>fetchClassTagOf: (in category 'interpreter access') -----
fetchClassTagOf: oop
+ self subclassResponsibility!
- | tagBits |
- (tagBits := oop bitAnd: self tagMask) ~= 0 ifTrue:
- [^(tagBits bitAnd: 1) ~= 0 ifTrue: [1] ifFalse: [tagBits]].
- ^self classIndexOf: oop!
Item was added:
+ ----- Method: SpurMemoryManager>>is:instanceOf: (in category 'object access') -----
+ is: oop instanceOf: classOop
+ "Answer if oop is an instance of the given class."
+
+ <inline: true>
+ | tag |
+ tag := self fetchClassTagOf: oop.
+ ^tag = (self rawHashBitsOf: classOop)!
Item was added:
+ ----- Method: SpurMemoryManager>>rawClassTagForClass: (in category 'interpreter access') -----
+ rawClassTagForClass: classObj
+ "Answer the classObj's identityHash to use as a tag in a class comparison."
+ ^self rawHashBitsOf: classObj!
Item was changed:
----- Method: StackInterpreter class>>initializeBytecodeTableForSistaV1 (in category 'initialization') -----
initializeBytecodeTableForSistaV1
"See e.g. the cass comment for EncoderForSistaV1"
"StackInterpreter initializeBytecodeTableForSistaV1"
"Note: This table will be used to generate a C switch statement."
BytecodeTable := Array new: 256.
self table: BytecodeTable from:
#( "1 byte bytecodes"
( 0 15 pushReceiverVariableBytecode)
( 16 31 pushLiteralVariable16CasesBytecode)
( 32 63 pushLiteralConstantBytecode)
( 64 75 pushTemporaryVariableBytecode)
( 76 pushReceiverBytecode)
( 77 pushConstantTrueBytecode)
( 78 pushConstantFalseBytecode)
( 79 pushConstantNilBytecode)
( 80 pushConstantZeroBytecode)
( 81 pushConstantOneBytecode)
( 82 extPushPseudoVariable)
( 83 duplicateTopBytecode)
( 84 87 unknownBytecode)
( 88 returnReceiver)
( 89 returnTrue)
( 90 returnFalse)
( 91 returnNil)
( 92 returnTopFromMethod)
( 93 returnNilFromBlock)
( 94 returnTopFromBlock)
( 95 extNopBytecode)
( 96 bytecodePrimAdd)
( 97 bytecodePrimSubtract)
( 98 bytecodePrimLessThanSistaV1) "for booleanCheatSistaV1:"
( 99 bytecodePrimGreaterThanSistaV1) "for booleanCheatSistaV1:"
(100 bytecodePrimLessOrEqualSistaV1) "for booleanCheatSistaV1:"
(101 bytecodePrimGreaterOrEqualSistaV1) "for booleanCheatSistaV1:"
(102 bytecodePrimEqualSistaV1) "for booleanCheatSistaV1:"
(103 bytecodePrimNotEqualSistaV1) "for booleanCheatSistaV1:"
(104 bytecodePrimMultiply)
(105 bytecodePrimDivide)
(106 bytecodePrimMod)
(107 bytecodePrimMakePoint)
(108 bytecodePrimBitShift)
(109 bytecodePrimDiv)
(110 bytecodePrimBitAnd)
(111 bytecodePrimBitOr)
(112 bytecodePrimAt)
(113 bytecodePrimAtPut)
(114 bytecodePrimSize)
(115 bytecodePrimNext) "i.e. a 0 arg special selector"
(116 bytecodePrimNextPut) "i.e. a 1 arg special selector"
(117 bytecodePrimAtEnd)
(118 bytecodePrimIdenticalSistaV1) "for booleanCheatSistaV1:"
(119 bytecodePrimClass)
(120 bytecodePrimSpecialSelector24) "was blockCopy:"
(121 bytecodePrimValue)
(122 bytecodePrimValueWithArg)
(123 bytecodePrimDo) "i.e. a 1 arg special selector"
(124 bytecodePrimNew) "i.e. a 0 arg special selector"
(125 bytecodePrimNewWithArg) "i.e. a 1 arg special selector"
(126 bytecodePrimPointX) "i.e. a 0 arg special selector"
(127 bytecodePrimPointY) "i.e. a 0 arg special selector"
(128 143 sendLiteralSelector0ArgsBytecode)
(144 159 sendLiteralSelector1ArgBytecode)
(160 175 sendLiteralSelector2ArgsBytecode)
(176 183 shortUnconditionalJump)
(184 191 shortConditionalJumpTrue)
(192 199 shortConditionalJumpFalse)
(200 207 storeAndPopReceiverVariableBytecode)
(208 215 storeAndPopTemporaryVariableBytecode)
(216 popStackBytecode)
(217 223 unknownBytecode)
"2 byte bytecodes"
(224 extABytecode)
(225 extBBytecode)
(226 extPushReceiverVariableBytecode)
(227 extPushLiteralVariableBytecode)
(228 extPushLiteralBytecode)
(229 longPushTemporaryVariableBytecode)
(230 pushClosureTempsBytecode)
(231 pushNewArrayBytecode)
(232 extPushIntegerBytecode)
(233 extPushCharacterBytecode)
(234 extSendBytecode)
(235 extSendSuperBytecode)
+ (236 extTrapIfNotInstanceOfBehaviorsBytecode)
- (236 extTrapOnBehaviorsBytecode)
(237 extUnconditionalJump)
(238 extJumpIfTrue)
(239 extJumpIfFalse)
(240 extStoreAndPopReceiverVariableBytecode)
(241 extStoreAndPopLiteralVariableBytecode)
(242 longStoreAndPopTemporaryVariableBytecode)
(243 extStoreReceiverVariableBytecode)
(244 extStoreLiteralVariableBytecode)
(245 longStoreTemporaryVariableBytecode)
(246 247 unknownBytecode)
"3 byte bytecodes"
(248 callPrimitiveBytecode)
(249 unknownBytecode) "reserved for Push Float"
(250 extPushClosureBytecode)
(251 pushRemoteTempLongBytecode)
(252 storeRemoteTempLongBytecode)
(253 storeAndPopRemoteTempLongBytecode)
(254 255 unknownBytecode)
)!
Item was changed:
----- Method: StackInterpreter class>>preambleCCode (in category 'translation') -----
preambleCCode
^
'/* Disable Intel compiler inlining of warning which is used for breakpoints */
#pragma auto_inline off
sqInt warnpid;
void
warning(char *s) { /* Print an error message but don''t exit. */
if (warnpid)
+ printf("\n%s pid %ld\n", s, (long)warnpid);
- printf("\n%s pid %ld\n", s, warnpid);
else
printf("\n%s\n", s);
}
void
warningat(char *s, int l) { /* ditto with line number. */
/* use alloca to call warning so one does not have to remember to set two breakpoints... */
char *sl = alloca(strlen(s) + 16);
sprintf(sl, "%s %d", s, l);
warning(sl);
}
#pragma auto_inline on
void
invalidCompactClassError(char *s) { /* Print a (compact) class index error message and exit. */
#if SPURVM
printf("\nClass %s does not have the required class index\n", s);
#else
printf("\nClass %s does not have the required compact class index\n", s);
#endif
exit(-1);
}
/*
* Define sigsetjmp and siglongjmp to be the most minimal setjmp/longjmp available on the platform.
*/
#if WIN32
# define sigsetjmp(jb,ssmf) setjmp(jb)
# define siglongjmp(jb,v) longjmp(jb,v)
#else
# define sigsetjmp(jb,ssmf) _setjmp(jb)
# define siglongjmp(jb,v) _longjmp(jb,v)
#endif
'!
Item was changed:
----- Method: StackInterpreter>>booleanCheatFalse (in category 'utilities') -----
booleanCheatFalse
"cheat the interpreter out of the pleasure of handling the next bytecode IFF it is a jump-on-boolean. Which it is, often enough when the current bytecode is something like bytecodePrimEqual"
+ <sharedCodeInCase: #bytecodePrimGreaterThan>
- <sharedCodeNamed: 'booleanCheatFalse' inCase: #bytecodePrimGreaterThan>
| bytecode offset |
bytecode := self fetchByte. "assume next bytecode is jumpIfFalse (99%)"
self internalPop: 2.
(bytecode < 160 and: [bytecode > 151]) ifTrue: "short jumpIfFalse"
[^self jump: bytecode - 151].
bytecode = 172 ifTrue: "long jumpIfFalse"
[offset := self fetchByte.
^self jump: offset].
"not followed by a jumpIfFalse; (un)do instruction fetch and push boolean result"
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [currentBytecode := bytecode + bytecodeSetSelector]
ifFalse: [currentBytecode := bytecode].
self internalPush: objectMemory falseObject!
Item was changed:
----- Method: StackInterpreter>>booleanCheatFalseSistaV1 (in category 'utilities') -----
booleanCheatFalseSistaV1
"cheat the interpreter out of the pleasure of handling the next bytecode IFF it is a jump-on-boolean. Which it is, often enough when the current bytecode is something like bytecodePrimEqual"
+ <sharedCodeInCase: #bytecodePrimGreaterThanSistaV1>
- <sharedCodeNamed: 'booleanCheatFalseSistaV1' inCase: #bytecodePrimGreaterThanSistaV1>
| bytecode offset |
bytecode := self fetchByte. "assume next bytecode is jumpIfFalse (99%)"
self internalPop: 2.
(bytecode < 199 and: [bytecode > 191]) ifTrue: "short jumpIfFalse"
[^self jump: bytecode - 191].
bytecode = 239 ifTrue: "long jumpIfFalse"
[offset := self fetchByte.
^self jump: offset].
"not followed by a jumpIfFalse; (un)do instruction fetch and push boolean result"
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [currentBytecode := bytecode + bytecodeSetSelector]
ifFalse: [currentBytecode := bytecode].
self internalPush: objectMemory falseObject!
Item was changed:
----- Method: StackInterpreter>>booleanCheatFalseV4 (in category 'utilities') -----
booleanCheatFalseV4
"cheat the interpreter out of the pleasure of handling the next bytecode IFF it is a jump-on-boolean. Which it is, often enough when the current bytecode is something like bytecodePrimEqual"
+ <sharedCodeInCase: #bytecodePrimGreaterThanV4>
- <sharedCodeNamed: 'booleanCheatFalseV4' inCase: #bytecodePrimGreaterThanV4>
| bytecode offset |
bytecode := self fetchByte. "assume next bytecode is jumpIfFalse (99%)"
self internalPop: 2.
(bytecode < 216 and: [bytecode > 207]) ifTrue: "short jumpIfFalse"
[^self jump: bytecode - 207].
bytecode = 244 ifTrue: "long jumpIfFalse"
[offset := self fetchByte.
^self jump: offset].
"not followed by a jumpIfFalse; (un)do instruction fetch and push boolean result"
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [currentBytecode := bytecode + bytecodeSetSelector]
ifFalse: [currentBytecode := bytecode].
self internalPush: objectMemory falseObject!
Item was changed:
----- Method: StackInterpreter>>booleanCheatTrue (in category 'utilities') -----
booleanCheatTrue
"cheat the interpreter out of the pleasure of handling the next bytecode IFF it is a jump-on-boolean. Which it is, often enough when the current bytecode is something like bytecodePrimEqual"
+ <sharedCodeInCase: #bytecodePrimLessThan>
- <sharedCodeNamed: 'booleanCheatTrue' inCase: #bytecodePrimLessThan>
| bytecode offset |
bytecode := self fetchByte. "assume next bytecode is jumpIfFalse (99%)"
self internalPop: 2.
(bytecode < 173 and: [bytecode > 151]) ifTrue:
[bytecode < 160 ifTrue: "short jumpIfFalse 152 - 159"
[^self fetchNextBytecode].
bytecode = 172 ifTrue: "long jumpIfFalse"
[self fetchByte.
^self fetchNextBytecode].
bytecode > 167 ifTrue: "long jumpIfTrue 168 - 171"
[offset := bytecode - 168 << 8 + self fetchByte.
^self jump: offset]].
"not followed by a jumpIfFalse; (un)do instruction fetch and push boolean result"
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [currentBytecode := bytecode + bytecodeSetSelector]
ifFalse: [currentBytecode := bytecode].
self internalPush: objectMemory trueObject!
Item was changed:
----- Method: StackInterpreter>>booleanCheatTrueSistaV1 (in category 'utilities') -----
booleanCheatTrueSistaV1
"cheat the interpreter out of the pleasure of handling the next bytecode IFF it is a jump-on-boolean. Which it is, often enough when the current bytecode is something like bytecodePrimEqual"
+ <sharedCodeInCase: #bytecodePrimLessThanSistaV1>
- <sharedCodeNamed: 'booleanCheatTrueSistaV1' inCase: #bytecodePrimLessThanSistaV1>
| bytecode offset |
bytecode := self fetchByte. "assume next bytecode is jumpIfFalse (99%)"
self internalPop: 2.
bytecode >= 192 ifTrue:
[bytecode <= 199 ifTrue: "short jumpIfFalse 192 - 199"
[^self fetchNextBytecode].
bytecode = 239 ifTrue: "long jumpIfFalse"
[self fetchByte.
^self fetchNextBytecode].
bytecode = 238 ifTrue: "long jumpIfTrue 238"
[offset := self fetchByte.
^self jump: offset]].
"not followed by a jumpIfFalse; (un)do instruction fetch and push boolean result"
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [currentBytecode := bytecode + bytecodeSetSelector]
ifFalse: [currentBytecode := bytecode].
self internalPush: objectMemory trueObject!
Item was changed:
----- Method: StackInterpreter>>booleanCheatTrueV4 (in category 'utilities') -----
booleanCheatTrueV4
"cheat the interpreter out of the pleasure of handling the next bytecode IFF it is a jump-on-boolean. Which it is, often enough when the current bytecode is something like bytecodePrimEqual"
+ <sharedCodeInCase: #bytecodePrimLessThanV4>
- <sharedCodeNamed: 'booleanCheatTrueV4' inCase: #bytecodePrimLessThanV4>
| bytecode offset |
bytecode := self fetchByte. "assume next bytecode is jumpIfFalse (99%)"
self internalPop: 2.
bytecode >= 208 ifTrue:
[bytecode <= 215 ifTrue: "short jumpIfFalse 208 - 215"
[^self fetchNextBytecode].
bytecode = 244 ifTrue: "long jumpIfFalse"
[self fetchByte.
^self fetchNextBytecode].
bytecode = 243 ifTrue: "long jumpIfTrue 243"
[offset := self fetchByte.
^self jump: offset]].
"not followed by a jumpIfFalse; (un)do instruction fetch and push boolean result"
self cppIf: MULTIPLEBYTECODESETS
ifTrue: [currentBytecode := bytecode + bytecodeSetSelector]
ifFalse: [currentBytecode := bytecode].
self internalPush: objectMemory trueObject!
Item was changed:
----- Method: StackInterpreter>>commonCallerReturn (in category 'return bytecodes') -----
commonCallerReturn
"Return to the previous context/frame (sender for method activations, caller for block activations)."
+ <sharedCodeInCase: #returnTopFromBlock>
- <sharedCodeNamed: 'commonCallerReturn' inCase: #returnTopFromBlock>
| callersFPOrNull |
<var: #callersFPOrNull type: #'char *'>
callersFPOrNull := self frameCallerFP: localFP.
callersFPOrNull == 0 "baseFrame" ifTrue:
[self assert: localFP = stackPage baseFP.
^self baseFrameReturn].
localIP := self frameCallerSavedIP: localFP.
localSP := localFP + (self frameStackedReceiverOffset: localFP).
localFP := callersFPOrNull.
self setMethod: (self frameMethod: localFP).
self fetchNextBytecode.
self internalStackTopPut: localReturnValue!
Item was changed:
----- Method: StackInterpreter>>commonReturn (in category 'return bytecodes') -----
commonReturn
"Do an ^-return (return form method), perhaps checking for unwinds if this is a block activation.
Note: Assumed to be inlined into the dispatch loop."
+ <sharedCodeInCase: #returnReceiver>
- <sharedCodeNamed: 'commonReturn' inCase: #returnReceiver>
| closure home unwindContextOrNilOrZero frameToReturnTo contextToReturnTo theFP callerFP newPage |
<var: #frameToReturnTo type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #newPage type: #'StackPage *'>
<var: #thePage type: #'StackPage *'>
"If this is a method simply return to the sender/caller."
(self frameIsBlockActivation: localFP) ifFalse:
[^self commonCallerReturn].
"Since this is a block activation the closure is on the stack above any args and the frame."
closure := self pushedReceiverOrClosureOfFrame: localFP.
home := nil.
"Walk the closure's lexical chain to find the context or frame to return from (home)."
[closure ~= objectMemory nilObject] whileTrue:
[home := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closure.
closure := objectMemory fetchPointer: ClosureIndex ofObject: home].
"home is to be returned from provided there is no unwind-protect activation between
this frame and home's sender. Search for an unwind. findUnwindThroughContext:
will answer either the context for an unwind-protect activation or nilObj if the sender
cannot be found or 0 if no unwind is found but the sender is. We must update the
current page's headFrame pointers to enable the search to identify widowed contexts
correctly."
self writeBackHeadFramePointers.
unwindContextOrNilOrZero := self internalFindUnwindThroughContext: home.
unwindContextOrNilOrZero = objectMemory nilObject ifTrue:
["error: can't find home on chain; cannot return"
^self internalCannotReturn: localReturnValue].
unwindContextOrNilOrZero ~= 0 ifTrue:
[^self internalAboutToReturn: localReturnValue through: unwindContextOrNilOrZero].
"Now we know home is on the sender chain.
We could be returning to either a context or a frame. Find out which."
contextToReturnTo := nil.
(self isMarriedOrWidowedContext: home)
ifTrue:
[self assert: (self checkIsStillMarriedContext: home currentFP: localFP).
theFP := self frameOfMarriedContext: home.
(self isBaseFrame: theFP)
ifTrue:
[contextToReturnTo := self frameCallerContext: theFP]
ifFalse:
[frameToReturnTo := self frameCallerFP: theFP]]
ifFalse:
[contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home.
((objectMemory isContext: contextToReturnTo)
and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue:
[self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
frameToReturnTo := self frameOfMarriedContext: contextToReturnTo.
contextToReturnTo := nil]].
"If returning to a context we must make a frame for it unless it is dead."
contextToReturnTo ~= nil ifTrue:
[frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo.
frameToReturnTo == 0 ifTrue:
["error: home's sender is dead; cannot return"
^self internalCannotReturn: localReturnValue]].
"Now we have a frame to return to. If it is on a different page we must free intervening pages and
nil out intervening contexts. We must free intervening stack pages because if we leave the pages
to be divorced then their contexts will be divorced with intact senders and instruction pointers. This
code is similar to primitiveTerminateTo. We must move any frames on itervening pages above the
frame linked to because these may be in use, e.g. via co-routining (see baseFrameReturn)."
self assert: stackPages pageListIsWellFormed.
newPage := stackPages stackPageFor: frameToReturnTo.
newPage ~~ stackPage ifTrue:
[| currentCtx thePage nextCntx |
currentCtx := self frameCallerContext: stackPage baseFP.
self assert: (objectMemory isContext: currentCtx).
stackPages freeStackPage: stackPage.
[self assert: (objectMemory isContext: currentCtx).
(self isMarriedOrWidowedContext: currentCtx)
and: [(stackPages stackPageFor: (theFP := self frameOfMarriedContext: currentCtx)) = newPage]] whileFalse:
[(self isMarriedOrWidowedContext: currentCtx)
ifTrue:
[thePage := stackPages stackPageFor: theFP.
theFP ~= thePage headFP ifTrue:
["Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
self moveFramesIn: thePage through: (self findFrameAbove: theFP inPage: thePage) toPage: self newStackPage].
currentCtx := self frameCallerContext: thePage baseFP.
stackPages freeStackPage: thePage]
ifFalse:
[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
self markContextAsDead: currentCtx.
currentCtx := nextCntx]].
self setStackPageAndLimit: newPage.
localSP := stackPage headSP.
localFP := stackPage headFP].
"Two cases. Returning to the top frame on a new page or an interior frame on the current page.
The top frame has its instruction pointer on top of stack. An interior frame has its instruction pointer
in the caller frame. We need to peel back any frames on the page until we get to the correct frame."
localFP = frameToReturnTo
ifTrue: "pop the saved IP, push the return value and continue."
[localIP := self pointerForOop: self internalStackTop]
ifFalse:
[[callerFP := localFP.
localFP := self frameCallerFP: localFP.
localFP ~~ frameToReturnTo] whileTrue.
localIP := self frameCallerSavedIP: callerFP.
localSP := (self frameCallerSP: callerFP) - BytesPerWord].
self setMethod: (self frameMethod: localFP).
self fetchNextBytecode.
^self internalStackTopPut: localReturnValue!
Item was changed:
----- Method: StackInterpreter>>commonSend (in category 'send bytecodes') -----
commonSend
"Send a message, starting lookup with the receiver's class."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
+ <sharedCodeInCase: #singleExtendedSendBytecode>
- <sharedCodeNamed: 'commonSend' inCase: #singleExtendedSendBytecode>
self sendBreakpoint: messageSelector receiver: (self internalStackValue: argumentCount).
self printSends ifTrue:
[self printActivationNameForSelector: messageSelector startClass: (objectMemory classForClassTag: lkupClassTag); cr].
self internalFindNewMethod.
self internalExecuteNewMethod.
self fetchNextBytecode!
Item was changed:
----- Method: StackInterpreter>>commonSendAbsentImplicit (in category 'send bytecodes') -----
commonSendAbsentImplicit
"Send a message to the implicit receiver for that message."
"Assume: messageSelector and argumentCount have been set, and that
the arguments but not the receiver have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
"160-175 1010 i i i i Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments"
"240 11110000 i i i i i j j j Send To Absent Implicit Receiver Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
+ <sharedCodeInCase: #extSendAbsentImplicitBytecode>
- <sharedCodeNamed: 'commonSendAbsentImplicit' inCase: #extSendAbsentImplicitBytecode>
| implicitReceiver |
implicitReceiver := self
implicitReceiverFor: self receiver
mixin: (self methodClassOf: method)
implementing: messageSelector.
self shuffleArgumentsAndStoreAbsentReceiver: implicitReceiver.
lkupClassTag := objectMemory fetchClassTagOf: implicitReceiver.
self assert: lkupClassTag ~= objectMemory nilObject.
self commonSend!
Item was added:
+ ----- Method: StackInterpreter>>extTrapIfNotInstanceOfBehaviorsBytecode (in category 'sista bytecodes') -----
+ extTrapIfNotInstanceOfBehaviorsBytecode
+ "SistaV1: * 236 11101100 iiiiiiii Trap If Not Instance Of Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)"
+ | tos tosClassTag literal |
+ tos := self stackTop.
+ tosClassTag := objectMemory fetchClassTagOf: tos.
+ literal := self literal: extA << 8 + self fetchByte.
+ extA := 0.
+ (objectMemory isArrayNonImm: literal)
+ ifTrue:
+ [| i |
+ i := (objectMemory numSlotsOf: literal) asInteger.
+ [(i := i -1) < 0
+ or: [tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal))]] whileTrue.
+ i < 0 ifTrue:
+ [^self respondToClassTrap]]
+ ifFalse:
+ [tosClassTag ~= (objectMemory rawClassTagForClass: literal) ifTrue:
+ [^self respondToClassTrap]].
+ self fetchNextBytecode!
Item was changed:
----- Method: StackInterpreter>>normalSend (in category 'send bytecodes') -----
normalSend
"Send a message, starting lookup with the receiver's class."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
+ <sharedCodeInCase: #singleExtendedSendBytecode>
- <sharedCodeNamed: 'normalSend' inCase: #singleExtendedSendBytecode>
| rcvr |
rcvr := self internalStackValue: argumentCount.
lkupClassTag := objectMemory fetchClassTagOf: rcvr.
self assert: lkupClassTag ~= objectMemory nilObject.
self commonSend!
Item was added:
+ ----- Method: StackInterpreter>>respondToClassTrap (in category 'sista bytecodes') -----
+ respondToClassTrap
+ | ourContext tos |
+ <sharedCodeInCase: #extTrapIfNotInstanceOfBehaviorsBytecode>
+ messageSelector := objectMemory splObj: SelectorClassTrap.
+ tos := self internalStackTop.
+ ourContext := self ensureFrameIsMarried: localFP SP: localSP.
+ messageSelector = objectMemory nilObject ifTrue:
+ [self error: 'class trap'].
+ self internalPush: ourContext.
+ self internalPush: tos.
+ argumentCount := 1.
+ self normalSend!
Item was changed:
----- Method: StackInterpreter>>respondToUnknownBytecode (in category 'miscellaneous bytecodes') -----
respondToUnknownBytecode
"If an error selector is available then send it to the activeContext, otherwise abort."
+ <sharedCodeInCase: #unknownBytecode>
- <sharedCodeNamed: #respondToUnknownBytecode inCase: #unknownBytecode>
| ourContext |
messageSelector := objectMemory maybeSplObj: SelectorUnknownBytecode.
(messageSelector isNil
or: [messageSelector = objectMemory nilObject]) ifTrue:
[self error: 'Unknown bytecode'].
ourContext := self ensureFrameIsMarried: localFP SP: localSP.
"undo fetch of bytecode so that context's pc is pointing to the unknown bytecode."
localIP := localIP - 1.
self internalPush: ourContext.
argumentCount := 0.
self normalSend!
Item was changed:
----- Method: StackInterpreter>>superclassSend (in category 'send bytecodes') -----
superclassSend
"Send a message to self, starting lookup with the superclass of the class
containing the currently executing method."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
+ <sharedCodeInCase: #singleExtendedSuperBytecode>
- <sharedCodeNamed: 'commonSupersend' inCase: #singleExtendedSuperBytecode>
| superclass |
superclass := self superclassOf: (self methodClassOf: method).
objectMemory ensureBehaviorHash: superclass.
lkupClassTag := objectMemory classTagForClass: superclass.
self assert: lkupClassTag ~= objectMemory nilObject.
self commonSend!
Item was changed:
----- Method: TCaseStmtNode>>processSharedCodeBlocks:forCase:in:method:expandedCases: (in category 'transformations') -----
processSharedCodeBlocks: caseTree forCase: caseIndex in: codeGen method: aTMethod expandedCases: seen
"Process any shared code blocks in the case parse tree for the given case, either inlining them or making them a 'goto sharedLabel'."
| caseMethod map meth sharedNode exitLabel |
exitLabel := nil.
"caseTree is expected to be a TStmtListNode whose first element is a comment
and whose second element is a TInlineNode for a method."
caseMethod := caseTree statements second method.
[sharedNode := nil.
map := IdentityDictionary new.
caseTree nodesDo:
[:node|
+ (sharedNode isNil
+ and: [node isSend
- (node isSend
and:[(meth := codeGen methodNamed: node selector) notNil
+ and:[meth sharedCase notNil]]]) ifTrue:
- and:[meth sharedCase notNil]]) ifTrue:
[(meth sharedCase = (meth sharedCase isSymbol
ifTrue: [caseMethod selector]
ifFalse: [caseIndex])
and: [(seen includes: meth sharedLabel) not])
ifTrue:
+ ["If the bytecode (the caseMethod) ends with a message that has a lastCase (and lastLabel) then
+ that will be converted into a goto and control will continue to that code, If the bytecode does
+ /not/ end with a message that has a lastCase (and lastLabel) then control should not continue to
+ that shared case. expandViaFallThrough captures this, true for the former, false for the latter."
+ | expandViaFallThrough |
+ expandViaFallThrough := false.
+ caseMethod statements last isSend ifTrue:
+ [(codeGen methodNamed: caseMethod statements last selector) ifNotNil:
+ [:m| expandViaFallThrough := m sharedCase notNil]].
- [sharedNode := meth.
seen add: meth sharedLabel.
+ map
+ at: node
+ put: (expandViaFallThrough
+ ifTrue: [sharedNode := meth.
+ TLabeledCommentNode new setComment: 'goto ', meth sharedLabel]
+ ifFalse: ["Still need recursive expansjon to continue but don't want
+ to duplicate the node, so substitue an empty method."
+ sharedNode := TLabeledCommentNode new setComment: 'null '.
+ meth copy
+ renameLabelsForInliningInto: aTMethod;
+ addLabelsTo: aTMethod;
+ asInlineNode])]
- map at: node put: (TLabeledCommentNode new setComment: 'goto ', meth sharedLabel)]
ifFalse:
[map at: node put: (TGoToNode new setLabel: meth sharedLabel)]]].
caseTree replaceNodesIn: map.
"recursively expand"
+ sharedNode notNil]
+ whileTrue:
+ [sharedNode isTMethod ifTrue:
+ [meth := sharedNode copy.
+ meth hasReturn ifTrue:
+ [exitLabel ifNil:
+ [exitLabel := aTMethod unusedLabelForInliningInto: aTMethod.
+ aTMethod labels add: exitLabel].
+ meth exitVar: nil label: exitLabel].
+ meth
+ renameLabelsForInliningInto: aTMethod;
+ addLabelsTo: aTMethod.
+ caseTree setStatements: (caseTree statements copyWith: meth asInlineNode)]].
- sharedNode == nil]
- whileFalse:
- [meth := sharedNode copy.
- meth hasReturn ifTrue:
- [exitLabel ifNil:
- [exitLabel := aTMethod unusedLabelForInliningInto: aTMethod.
- aTMethod labels add: exitLabel].
- meth exitVar: nil label: exitLabel].
- meth renameLabelsForInliningInto: aTMethod.
- aTMethod labels addAll: meth labels.
- caseTree setStatements: (caseTree statements copyWith: meth asInlineNode)].
exitLabel ifNotNil:
[caseTree setStatements: (caseTree statements copyWith:
(TLabeledCommentNode new setLabel: exitLabel comment: 'end case'))]!
Item was added:
+ ----- Method: TMethod>>addLabelsTo: (in category 'accessing') -----
+ addLabelsTo: aTMethod
+ aTMethod labels addAll: labels!
Item was changed:
----- Method: TMethod>>extractSharedCase (in category 'transformations') -----
extractSharedCase
+ "Scan the pragmas for an shared case directive of the form:
+ <sharedCodeNamed: 'sharedLabel' inCase: 'sharedCase'.>
+ <sharedCodeInCase: 'sharedCase'.>
+ or the older top-level statements for the form
+ self sharedCodeNamed: 'sharedLabel' inCase: 'sharedCase'.
+ self sharedCodeInCase: 'sharedCase'.
+ in which case remove the directive from the method body."
- "Scan the top-level statements for an shared case directive of the form:
- self sharedCodeNamed: <sharedLabel> inCase: <sharedCase>.
-
- and remove the directive from the method body."
-
self extractDirective: #sharedCodeNamed:inCase:
valueBlock: [:sendNode|
args isEmpty ifFalse:
[self error: 'Cannot share code sections in methods with arguments'].
sharedLabel := sendNode args first value.
sharedCase := sendNode args last value]
+ default: nil.
+ self extractDirective: #sharedCodeInCase:
+ valueBlock: [:sendNode|
+ args isEmpty ifFalse:
+ [self error: 'Cannot share code sections in methods with arguments'].
+ sharedLabel := selector.
+ sharedCase := sendNode args last value]
default: nil!
Item was added:
+ ----- Method: TMethod>>isTMethod (in category 'testing') -----
+ isTMethod
+ ^true!
Item was added:
+ ----- Method: TParseNode>>isTMethod (in category 'testing') -----
+ isTMethod
+ ^false!
1
0