[Vm-dev] VM Maker: VMMaker.oscog-eem.2292.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Dec 8 23:00:35 UTC 2017
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2292.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2292
Author: eem
Time: 8 December 2017, 3:00:06.051233 pm
UUID: be5cc6cd-dd15-479b-903e-8dadd3746d9b
Ancestors: VMMaker.oscog-eem.2291
Interpreter: Eliminate some uses of #== to compare integral values.
Slang:
(Hopefully!) Eliminate unused local variable warnings by having TMethod code generation output the body to a scratch stream, noting used variables encountered during generation, and then outputting only variables that were seen during the parse (since the code egnerator does dead code eleimination during generation).
Better format labels, trying to indent them by a single tab.
=============== Diff against VMMaker.oscog-eem.2291 ===============
Item was changed:
----- Method: CCodeGenerator>>generateInlineCCode:on:indent: (in category 'C translation') -----
generateInlineCCode: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream.
There are two forms, self cCode: aString ... and self cCode: aBlock."
msgNode args first isConstant
ifTrue:
[(msgNode args first value at: 1 ifAbsent: nil) = $# ifTrue:
[aStream cr].
+ aStream nextPutAll: msgNode args first value.
+ self noteVariableUsageInString: msgNode args first value]
- aStream nextPutAll: msgNode args first value]
ifFalse: [msgNode args first
emitCCodeOn: aStream
level: level
generator: self]!
Item was changed:
----- Method: CCodeGenerator>>generateInlineCCodeAsArgument:on:indent: (in category 'C translation') -----
generateInlineCCodeAsArgument: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream.
There are two forms, self cCode: aString ... and self cCode: aBlock."
(msgNode args first isConstant
and: [msgNode args first value isString])
ifTrue:
[(msgNode args first value at: 1 ifAbsent: nil) = $# ifTrue:
[aStream cr].
+ aStream nextPutAll: msgNode args first value.
+ self noteVariableUsageInString: msgNode args first value]
- aStream nextPutAll: msgNode args first value]
ifFalse: [msgNode args first
emitCCodeAsArgumentOn: aStream
level: level
generator: self]!
Item was changed:
----- Method: CCodeGenerator>>generateInlineCPreprocessorDirective:on:indent: (in category 'C translation') -----
generateInlineCPreprocessorDirective: msgNode on: aStream indent: level
"Generate the C preprocessor directive for this message onto the given stream."
+ aStream cr; nextPutAll: msgNode args first value.
+ self noteVariableUsageInString: msgNode args first value!
- aStream cr; nextPutAll: msgNode args first value!
Item was added:
+ ----- Method: CCodeGenerator>>noteVariableUsageInString: (in category 'utilities') -----
+ noteVariableUsageInString: aString
+ currentMethod ifNotNil:
+ [:m|
+ (Scanner new typedScanTokens: aString) do:
+ [:token|
+ (token isString and: [token first isLetter or: [token first == $_]]) ifTrue:
+ [m noteUsedVariableName: token]]]!
Item was changed:
----- Method: CoInterpreter>>callbackEnter: (in category 'callback support') -----
callbackEnter: callbackID
"Re-enter the interpreter for executing a callback"
| currentCStackPointer currentCFramePointer savedReenterInterpreter
wasInMachineCode calledFromMachineCode |
<volatile>
<export: true>
<var: #currentCStackPointer type: #'void *'>
<var: #currentCFramePointer type: #'void *'>
<var: #callbackID type: #'sqInt *'>
<var: #savedReenterInterpreter type: #'jmp_buf'>
"For now, do not allow a callback unless we're in a primitiveResponse"
(self asserta: primitiveFunctionPointer ~= 0) ifFalse:
[^false].
self assert: primFailCode = 0.
"Check if we've exceeded the callback depth"
(self asserta: jmpDepth < MaxJumpBuf) ifFalse:
[^false].
jmpDepth := jmpDepth + 1.
wasInMachineCode := self isMachineCodeFrame: framePointer.
calledFromMachineCode := instructionPointer <= objectMemory startOfMemory.
"Suspend the currently active process"
suspendedCallbacks at: jmpDepth put: self activeProcess.
"We need to preserve newMethod explicitly since it is not activated yet
and therefore no context has been created for it. If the caller primitive
for any reason decides to fail we need to make sure we execute the correct
method and not the one 'last used' in the call back"
suspendedMethods at: jmpDepth put: newMethod.
self flag: 'need to debug this properly. Conceptually it is the right thing to do but it crashes in practice'.
false
ifTrue:
["Signal external semaphores since a signalSemaphoreWithIndex: request may
have been issued immediately prior to this callback before the VM has any
chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:"
self signalExternalSemaphores.
"If no process is awakened by signalExternalSemaphores then transfer
to the highest priority runnable one."
+ (suspendedCallbacks at: jmpDepth) = self activeProcess ifTrue:
- (suspendedCallbacks at: jmpDepth) == self activeProcess ifTrue:
[self transferTo: self wakeHighestPriority from: CSCallbackLeave]]
ifFalse:
[self transferTo: self wakeHighestPriority from: CSCallbackLeave].
"Typically, invoking the callback means that some semaphore has been
signaled to indicate the callback. Force an interrupt check as soon as possible."
self forceInterruptCheck.
"Save the previous CStackPointers and interpreter entry jmp_buf."
currentCStackPointer := cogit getCStackPointer.
currentCFramePointer := cogit getCFramePointer.
self mem: savedReenterInterpreter asVoidPointer
cp: reenterInterpreter
y: (self sizeof: #'jmp_buf').
cogit assertCStackWellAligned.
+ (self setjmp: (jmpBuf at: jmpDepth)) = 0 ifTrue: "Fill in callbackID"
- (self setjmp: (jmpBuf at: jmpDepth)) == 0 ifTrue: "Fill in callbackID"
[callbackID at: 0 put: jmpDepth.
self enterSmalltalkExecutive.
self assert: false "NOTREACHED"].
"Restore the previous CStackPointers and interpreter entry jmp_buf."
cogit setCStackPointer: currentCStackPointer.
cogit setCFramePointer: currentCFramePointer.
self mem: reenterInterpreter
cp: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
y: (self sizeof: #'jmp_buf').
"Transfer back to the previous process so that caller can push result"
self putToSleep: self activeProcess yieldingIf: preemptionYields.
self transferTo: (suspendedCallbacks at: jmpDepth) from: CSCallbackLeave.
newMethod := suspendedMethods at: jmpDepth. "see comment above"
argumentCount := self argumentCountOf: newMethod.
self assert: wasInMachineCode = (self isMachineCodeFrame: framePointer).
calledFromMachineCode
ifTrue:
[instructionPointer asUnsignedInteger >= objectMemory startOfMemory ifTrue:
[self iframeSavedIP: framePointer put: instructionPointer.
instructionPointer := cogit ceReturnToInterpreterPC]]
ifFalse:
["Even if the context was flushed to the heap and rebuilt in transferTo:from:
above it will remain an interpreted frame because the context's pc would
remain a bytecode pc. So the instructionPointer must also be a bytecode pc."
self assert: (self isMachineCodeFrame: framePointer) not.
self assert: instructionPointer > objectMemory startOfMemory].
self assert: primFailCode = 0.
jmpDepth := jmpDepth-1.
^true!
Item was changed:
----- Method: CoInterpreter>>ceNonLocalReturn: (in category 'trampolines') -----
ceNonLocalReturn: returnValue
<api>
| closure home unwindContextOrNilOrZero ourContext 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 *'>
"self shortPrintFrameAndCallers: framePointer.
self printOop: returnValue.
self halt."
self assert: (self isMachineCodeFrame: framePointer).
self assert: (self frameIsBlockActivation: framePointer).
"Since this is a block activation the closure is on the stack above any args and the frame."
closure := self pushedReceiverOrClosureOfFrame: framePointer.
home := nil.
"Walk the closure's lexical chain to find the context or frame to return from (home)."
[closure ~= objectMemory nilObject] whileTrue:
[home := objectMemory followField: ClosureOuterContextIndex ofObject: closure.
closure := objectMemory followField: 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 externalWriteBackHeadFramePointers.
unwindContextOrNilOrZero := self findUnwindThroughContext: home.
unwindContextOrNilOrZero = objectMemory nilObject ifTrue:
["error: can't find home on chain; cannot return"
ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
^self externalCannotReturn: returnValue from: ourContext].
unwindContextOrNilOrZero ~= 0 ifTrue:
[^self externalAboutToReturn: returnValue 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: framePointer).
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: framePointer).
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:
- frameToReturnTo == 0 ifTrue:
["error: home's sender is dead; cannot return"
ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
^self externalCannotReturn: returnValue from: ourContext]].
"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."
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.
currentCtx := self frameCallerContext: thePage baseFP.
stackPages freeStackPage: thePage]
ifFalse:
[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
self markContextAsDead: currentCtx.
currentCtx := nextCntx]].
self setStackPageAndLimit: newPage.
self setStackPointersFromPage: newPage].
"Two cases. Returning to the top frame or an interior frame. 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."
framePointer = frameToReturnTo
ifTrue:
[instructionPointer := self popStack]
ifFalse:
[[callerFP := framePointer.
framePointer := self frameCallerFP: framePointer.
framePointer ~~ frameToReturnTo] whileTrue.
instructionPointer := (self frameCallerSavedIP: callerFP) asUnsignedInteger.
stackPointer := (self frameCallerSP: callerFP)].
^self return: returnValue toExecutive: false!
Item was changed:
----- Method: CoInterpreter>>commonCallerReturn (in category 'return bytecodes') -----
commonCallerReturn
"Return to the previous context/frame (sender for method activations, caller for block activations)."
<sharedCodeNamed: 'commonCallerReturn' inCase: #returnTopFromBlock>
| callersFPOrNull doWeHaveANativeFrame |
<var: #callersFPOrNull type: #'char *'>
"TODO: Store/restore the nativeSP more properly, when it exists"
LowcodeVM ifTrue: [
doWeHaveANativeFrame := self frameHasNativeFrame: localFP.
doWeHaveANativeFrame ifTrue: [
nativeStackPointer := (self nativePreviousStackPointerIn: localFP) - 1.
nativeSP := 0.
self setFrameHasNotNativeFrame: localFP.
].
].
callersFPOrNull := self frameCallerFP: localFP.
+ callersFPOrNull = 0 "baseFrame" ifTrue:
- callersFPOrNull == 0 "baseFrame" ifTrue:
[self assert: localFP = stackPage baseFP.
^self baseFrameReturn].
localIP := self frameCallerSavedIP: localFP.
localSP := localFP + (self frameStackedReceiverOffset: localFP).
localFP := callersFPOrNull.
localIP asUnsignedInteger < objectMemory startOfMemory ifTrue:
[localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue:
["localIP in the cog method zone indicates a return to machine code."
^self returnToMachineCodeFrame].
localIP := self pointerForOop: (self iframeSavedIP: localFP)].
self setMethod: (self iframeMethod: localFP).
self fetchNextBytecode.
self internalStackTopPut: localReturnValue!
Item was changed:
----- Method: CoInterpreter>>instructionPointerForFrame:currentFP:currentIP: (in category 'frame access') -----
instructionPointerForFrame: spouseFP currentFP: currentFP currentIP: instrPtr
"Answer the bytecode pc object (i.e. SmallInteger) for an active frame. The bytecode
pc is derived from the frame's pc. If the frame is the top frame on the current stack
the frame pc is whatever the current instruction pointer is. If the frame is the top
frame on some other stack the frame pc is the value on top of stack. Otherwise the
frame pc is the saved pc of the frame above. Once the frame pc is found it must be
mapped to a bytecode pc."
<var: #spouseFP type: #'char *'>
<var: #currentFP type: #'char *'>
| value theIP thePage theFPAbove |
<var: #thePage type: #'StackPage *'>
<var: #theFPAbove type: #'char *'>
spouseFP = currentFP
ifTrue: [theIP := self oopForPointer: instrPtr]
ifFalse:
[thePage := stackPages stackPageFor: spouseFP.
theFPAbove := self findFrameAbove: spouseFP inPage: thePage.
+ theIP := theFPAbove = 0
- theIP := theFPAbove == 0
ifTrue: [stackPages longAt: thePage headSP]
ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]].
value := self contextInstructionPointer: theIP frame: spouseFP.
^value signedIntFromLong < 0
ifTrue: [self mustMapMachineCodePC: (objectMemory integerValueOf: value)
context: (self frameContext: spouseFP)]
ifFalse: [value]!
Item was changed:
----- Method: StackInterpreter>>callbackEnter: (in category 'callback support') -----
callbackEnter: callbackID
"Re-enter the interpreter for executing a callback"
<export: true>
<var: #callbackID type: #'sqInt *'>
"For now, do not allow a callback unless we're in a primitiveResponse"
(self asserta: primitiveFunctionPointer ~= 0) ifFalse:
[^false].
"Check if we've exceeded the callback depth"
(self asserta: jmpDepth < MaxJumpBuf) ifFalse:
[^false].
jmpDepth := jmpDepth + 1.
"Suspend the currently active process"
suspendedCallbacks at: jmpDepth put: self activeProcess.
"We need to preserve newMethod explicitly since it is not activated yet
and therefore no context has been created for it. If the caller primitive
for any reason decides to fail we need to make sure we execute the correct
method and not the one 'last used' in the call back"
suspendedMethods at: jmpDepth put: newMethod.
"Signal external semaphores since a signalSemaphoreWithIndex: request may
have been issued immediately prior to this callback before the VM has any
chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:"
self signalExternalSemaphores.
"If no process is awakened by signalExternalSemaphores then transfer
to the highest priority runnable one."
+ (suspendedCallbacks at: jmpDepth) = self activeProcess ifTrue:
- (suspendedCallbacks at: jmpDepth) == self activeProcess ifTrue:
[self transferTo: self wakeHighestPriority].
"Typically, invoking the callback means that some semaphore has been
signaled to indicate the callback. Force an interrupt check as soon as possible."
self forceInterruptCheck.
+ (self setjmp: (jmpBuf at: jmpDepth)) = 0 ifTrue: "Fill in callbackID"
- (self setjmp: (jmpBuf at: jmpDepth)) == 0 ifTrue: "Fill in callbackID"
[callbackID at: 0 put: jmpDepth.
self interpret].
"Transfer back to the previous process so that caller can push result"
self putToSleep: self activeProcess yieldingIf: preemptionYields.
self transferTo: (suspendedCallbacks at: jmpDepth).
newMethod := suspendedMethods at: jmpDepth. "see comment above"
argumentCount := self argumentCountOf: newMethod.
jmpDepth := jmpDepth-1.
"clean out the primPops etc since we'll be returning via primitive"
self initPrimCall.
^true!
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>
| callersFPOrNull doWeHaveANativeFrame |
<var: #callersFPOrNull type: #'char *'>
"TODO: Store/restore the nativeSP more properly, when it exists"
LowcodeVM ifTrue: [
doWeHaveANativeFrame := self frameHasNativeFrame: localFP.
doWeHaveANativeFrame ifTrue: [
nativeStackPointer := (self nativePreviousStackPointerIn: localFP) - 1.
nativeSP := 0.
self setFrameHasNotNativeFrame: localFP.
].
].
callersFPOrNull := self frameCallerFP: localFP.
+ callersFPOrNull = 0 "baseFrame" ifTrue:
- 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 from method), checking for unwinds if this is a block activation.
Note: Assumed to be inlined into the dispatch loop."
<sharedCodeInCase: #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 iframeIsBlockActivation: 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 followField: ClosureOuterContextIndex ofObject: closure.
closure := objectMemory followField: 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.
self externalizeIPandSP.
unwindContextOrNilOrZero := self findUnwindThroughContext: 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]].
- 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 intervening 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.
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: stackPages 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) - objectMemory wordSize].
self maybeReturnToMachineCodeFrame.
self setMethod: (self frameMethod: localFP).
self fetchNextBytecode.
self internalStackTopPut: localReturnValue!
Item was changed:
----- Method: StackInterpreter>>context:hasSender: (in category 'internal interpreter access') -----
context: thisCntx hasSender: aContext
"Does thisCntx have aContext in its sender chain?
Cheapo implementation above extant machinery."
| handlerOrNilOrZero |
<inline: true>
handlerOrNilOrZero := self
findMethodWithPrimitive: -1
FromContext: thisCntx
UpToContext: aContext.
+ ^handlerOrNilOrZero = 0!
- ^handlerOrNilOrZero == 0!
Item was changed:
----- Method: StackInterpreter>>externalDivorceFrame:andContext: (in category 'frame access') -----
externalDivorceFrame: theFP andContext: ctxt
"Divorce a single frame and its context. If it is not the top frame of a stack this means splitting its stack."
| thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP |
<inline: false>
<var: #theFP type: #'char *'>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #newPage type: #'StackPage *'>
<var: #frameAbove type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #callerSP type: #'char *'>
"stackPage needs to have current head pointers to avoid confusion."
self assert: (stackPage = 0 or: [stackPage = stackPages mostRecentlyUsedPage]).
thePage := stackPages stackPageFor: theFP.
(onCurrent := thePage = stackPage) ifFalse:
[stackPages markStackPageNextMostRecentlyUsed: thePage].
theSP := self findSPOf: theFP on: thePage.
self updateStateOfSpouseContextForFrame: theFP WithSP: theSP.
callerCtx := self ensureCallerContext: theFP.
+ (frameAbove := self findFrameAbove: theFP inPage: thePage) = 0
- (frameAbove := self findFrameAbove: theFP inPage: thePage) == 0
ifTrue: "If we're divorcing the top frame we can simply peel it off."
[theIP := stackPages longAt: thePage headSP]
ifFalse: "othewise move all frames above to a new stack and then peel the frame off."
[newPage := stackPages newStackPage.
theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove).
frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage.
onCurrent
ifTrue:
[self setStackPageAndLimit: newPage.
self setStackPointersFromPage: newPage]
ifFalse:
[stackPages markStackPageMostRecentlyUsed: newPage].
self assert: (self frameCallerContext: frameAbove) = ctxt].
objectMemory storePointerUnchecked: InstructionPointerIndex
ofObject: ctxt
withValue: (self contextInstructionPointer: theIP frame: theFP).
objectMemory storePointer: SenderIndex
ofObject: ctxt
withValue: callerCtx.
callerFP := self frameCallerFP: theFP.
+ callerFP = 0 "theFP is a base frame; it is now alone; free the entire page"
- callerFP == 0 "theFP is a base frame; it is now alone; free the entire page"
ifTrue: [stackPages freeStackPage: thePage]
ifFalse:
[callerIP := self oopForPointer: (self frameCallerSavedIP: theFP).
callerSP := (self frameCallerSP: theFP) - objectMemory wordSize.
stackPages longAt: callerSP put: callerIP.
self setHeadFP: callerFP andSP: callerSP inPage: thePage]
!
Item was changed:
----- Method: StackInterpreter>>imageFormatCompatibilityVersion (in category 'image save/restore') -----
imageFormatCompatibilityVersion
"This VM is backward-compatible with the immediately preceding version."
+ ^objectMemory wordSize = 4 ifTrue: [6504] ifFalse: [68002]!
- ^objectMemory wordSize == 4 ifTrue: [6504] ifFalse: [68002]!
Item was changed:
----- Method: StackInterpreter>>instructionPointerForFrame:currentFP:currentIP: (in category 'frame access') -----
instructionPointerForFrame: spouseFP currentFP: currentFP currentIP: instrPtr
"Answer the bytecode pc object (i.e. SmallInteger) for an active frame. The bytecode
pc is derived from the frame's pc. If the frame is the top frame on the current stack
the frame pc is whatever the current instruction pointer is. If the frame is the top
frame on some other stack the frame pc is the value on top of stack. Otherwise the
frame pc is the saved pc of the frame above. Once the frame pc is found it must be
mapped to a bytecode pc."
<var: #spouseFP type: #'char *'>
<var: #currentFP type: #'char *'>
| theIP thePage theFPAbove |
<var: #thePage type: #'StackPage *'>
<var: #theFPAbove type: #'char *'>
spouseFP = currentFP
ifTrue: [theIP := self oopForPointer: instrPtr]
ifFalse:
[thePage := stackPages stackPageFor: spouseFP.
theFPAbove := self findFrameAbove: spouseFP inPage: thePage.
+ theIP := theFPAbove = 0
- theIP := theFPAbove == 0
ifTrue: [stackPages longAt: thePage headSP]
ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]].
^self contextInstructionPointer: theIP frame: spouseFP!
Item was changed:
----- Method: StackInterpreter>>isBaseFrame: (in category 'frame access') -----
isBaseFrame: theFP
"A base frame (first frame in a stack page) is so marked by having a null saved fp."
<inline: true>
<var: #theFP type: #'char *'>
+ ^(stackPages longAt: theFP + FoxSavedFP) = 0!
- ^(stackPages longAt: theFP + FoxSavedFP) == 0!
Item was changed:
----- Method: TLabeledCommentNode>>printOptionalLabelOn: (in category 'printing') -----
printOptionalLabelOn: aStream
+ label ifNotNil:
+ [self unindentTabs: aStream.
+ aStream
+ nextPutAll: label;
+ nextPut: $:;
+ tab]!
- label ~= nil ifTrue: [
- self unindentOneTab: aStream.
- aStream nextPutAll: label.
- aStream nextPut: $:.
- aStream tab.
- ].!
Item was removed:
- ----- Method: TLabeledCommentNode>>unindentOneTab: (in category 'C code generation') -----
- unindentOneTab: aStream
- "Remove the last tab from the given stream if possible."
-
- (aStream isKindOf: ReadWriteStream) ifFalse: [ ^self ].
- aStream position > 0 ifTrue: [
- aStream position: aStream position - 1.
- "restore stream position if previous char was not a tab"
- aStream peek = Character tab ifFalse: [ aStream next ].
- ].!
Item was added:
+ ----- Method: TLabeledCommentNode>>unindentTabs: (in category 'C code generation') -----
+ unindentTabs: aStream
+ "Remove all but one tab up to the beginning of line from the given stream if possible."
+
+ (aStream isKindOf: ReadWriteStream) ifFalse: [ ^self ].
+ [aStream position > 0] whileTrue:
+ [aStream position: aStream position - 1.
+ "restore stream position if previous char was not a tab"
+ aStream peek == Character tab ifFalse:
+ [^aStream next; tab]]!
Item was changed:
Object subclass: #TMethod
+ instanceVariableNames: 'args comment complete declarations definingClass export extraVariableNumber globalStructureBuildMethodHasFoo inline labels locals parseTree primitive properties returnType selector sharedCase sharedLabel static writtenToGlobalVarsCache functionAttributes usedVariablesCache'
- instanceVariableNames: 'args comment complete declarations definingClass export extraVariableNumber globalStructureBuildMethodHasFoo inline labels locals parseTree primitive properties returnType selector sharedCase sharedLabel static writtenToGlobalVarsCache functionAttributes'
classVariableNames: 'CaseStatements'
poolDictionaries: ''
category: 'VMMaker-Translation to C'!
!TMethod commentStamp: 'dtl 9/15/2008 09:06' prior: 0!
A TMethod is a translation method, representing a MethodNode that is to be translated to C source. It has a parseTree of translation nodes that mirrors the parse tree of the corresponding Smalltalk method.!
Item was changed:
----- Method: TMethod>>emitCCodeOn:generator: (in category 'C code generation') -----
emitCCodeOn: aStream generator: aCodeGen
"Emit C code for this method onto the given stream.
All calls to inlined methods should already have been expanded."
+ | bodyStream conditional |
- | conditional |
aCodeGen currentMethod: self.
+ usedVariablesCache := Set new.
self emitCCommentOn: aStream. "place method comment and method name before function."
aStream crtab; nextPutAll: '/* '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self smalltalkSelector; nextPutAll: ' */'.
aStream cr.
conditional := self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
aStream cr; nextPut: ${.
+ bodyStream := ReadWriteStream on: (ByteString new: 128).
+ aCodeGen "Generation will note used variables in usedVariablesCache"
- self emitCLocalsOn: aStream generator: aCodeGen.
- aCodeGen
pushScope: declarations
+ while: [parseTree emitCCodeOn: bodyStream level: 1 generator: aCodeGen].
+ self emitCLocalsOn: aStream generator: aCodeGen.
+ usedVariablesCache := nil.
+ aStream nextPutAll: bodyStream contents.
- while: [parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen].
(returnType = #void or: [parseTree endsWithReturn]) ifFalse:
[aStream tab; nextPutAll: 'return 0;'; cr].
aStream nextPut: $}; cr.
conditional ifTrue:
[self terminateConditionalDefineFor: self compileTimeOptionPragmas on: aStream]!
Item was changed:
----- Method: TMethod>>emitCLocalsOn:generator: (in category 'C code generation') -----
emitCLocalsOn: aStream generator: aCodeGen
"Emit a C function header for this method onto the given stream."
| volatileVariables |
volatileVariables := properties includesKey: #volatile.
self refersToGlobalStruct ifTrue:
[aStream
next: 3 put: Character space; "there's already an opening ${ on this line; see sender"
nextPutAll: (volatileVariables
ifTrue: ['DECL_MAYBE_VOLATILE_SQ_GLOBAL_STRUCT']
ifFalse: ['DECL_MAYBE_SQ_GLOBAL_STRUCT'])].
aStream cr.
locals isEmpty ifFalse:
[(aCodeGen sortStrings: locals) do:
+ [ :var | | decl |
+ decl := self declarationAt: var.
+ (volatileVariables or: [(decl beginsWith: 'static') or: [usedVariablesCache includes: var]]) ifTrue:
+ [aStream next: 4 put: Character space.
+ volatileVariables ifTrue:
+ [aStream nextPutAll: #volatile; space].
+ aStream
+ nextPutAll: decl;
+ nextPut: $;;
+ cr]].
- [ :var |
- aStream next: 4 put: Character space.
- volatileVariables ifTrue:
- [aStream nextPutAll: #volatile; space].
- aStream
- nextPutAll: (self declarationAt: var);
- nextPut: $;;
- cr].
aStream cr]!
Item was added:
+ ----- Method: TMethod>>noteUsedVariableName: (in category 'utilities') -----
+ noteUsedVariableName: token
+ usedVariablesCache ifNotNil:
+ [usedVariablesCache add: token]!
Item was changed:
----- Method: TVariableNode>>emitCCodeOn:level:generator: (in category 'C code generation') -----
emitCCodeOn: aStream level: level generator: aCodeGen
aStream nextPutAll: (name = 'nil'
+ ifTrue: [aCodeGen cLiteralFor: nil]
+ ifFalse: [aCodeGen returnPrefixFromVariable: name]).
+ aCodeGen currentMethod ifNotNil:
+ [:m| m noteUsedVariableName: name]!
- ifTrue: [ aCodeGen cLiteralFor: nil ]
- ifFalse: [ aCodeGen returnPrefixFromVariable: name ])!
More information about the Vm-dev
mailing list