Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 10 additions & 4 deletions smalltalksrc/VMMaker/CoInterpreter.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -1564,8 +1564,11 @@ CoInterpreter >> ceSend: selector super: superNormalBar to: rcvr numArgs: numArg
methodOperand: (self mnuMethodOrNilFor: rcvr)
numArgs: argumentCount) asUnsignedInteger
> cogit minCogMethodAddress]) ifTrue:
[cogit
linkSendAt: (stackPages longAt: stackPointer)
[
|outerReturn|
outerReturn := self stackTop.
cogit
linkSendAt: outerReturn
in: (self mframeHomeMethod: framePointer)
to: cogMethod
offset: (superNormalBar = 0
Expand All @@ -1588,8 +1591,11 @@ CoInterpreter >> ceSend: selector super: superNormalBar to: rcvr numArgs: numArg
[:newCogMethod| cogMethod := newCogMethod]]].
cogMethod selector = selector
ifTrue:
[cogit
linkSendAt: (stackPages longAt: stackPointer)
[
|outerReturn|
outerReturn := self stackTop.
cogit
linkSendAt: outerReturn
in: (self mframeHomeMethod: framePointer)
to: cogMethod
offset: (superNormalBar = 0
Expand Down
8 changes: 4 additions & 4 deletions smalltalksrc/VMMaker/CogInLineLiteralsARMCompiler.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -170,10 +170,10 @@ CogInLineLiteralsARMCompiler >> rewriteInlineCacheAt: callSiteReturnAddress tag:
<var: #callSiteReturnAddress type: #usqInt>
<var: #callTargetAddress type: #usqInt>
| call callDistance |
false
ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
[self error: 'linking callsite to invalid address']].

callTargetAddress >= cogit minCallAddress ifFalse:
[self error: 'linking callsite to invalid address'].

callDistance := (callTargetAddress - (callSiteReturnAddress + 8 "pc offset"- 4 "return offset")) signedIntToLong.
self assert: (self isInImmediateJumpRange: callDistance). "we don't support long call updates here"
call := self bl: callDistance.
Expand Down