[Vm-dev] VM Maker: VMMaker.oscog-eem.835.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Jul 26 18:02:49 UTC 2014
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!
More information about the Vm-dev
mailing list