"====================================================================== | | ContextPart Method Definitions | | $Revision: 1.7.5$ | $Date: 2000/05/28 16:56:52$ | $Author: pb$ | ======================================================================" "====================================================================== | | Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc. | Written by Paolo Bonzini. | | This file is part of the GNU Smalltalk class library. | | The GNU Smalltalk class library is free software; you can redistribute it | and/or modify it under the terms of the GNU Lesser General Public License | as published by the Free Software Foundation; either version 2.1, or (at | your option) any later version. | | The GNU Smalltalk class library is distributed in the hope that it will be | useful, but WITHOUT ANY WARRANTY; without even the implied warranty of | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser | General Public License for more details. | | You should have received a copy of the GNU Lesser General Public License | along with the GNU Smalltalk class library; see the file COPYING.LESSER. | If not, write to the Free Software Foundation, 59 Temple Place - Suite | 330, Boston, MA 02111-1307, USA. | ======================================================================" Object variableSubclass: #ContextPart instanceVariableNames: 'parent ip sp receiver method ' classVariableNames: 'UnwindPoints' poolDictionaries: '' category: 'Language-Implementation' ! ContextPart comment: 'My instances represent executing Smalltalk code, which represent the local environment of executable code. They contain a stack and also provide some methods that can be used in inspection or debugging.' ! !ContextPart class methodsFor: 'exception handling'! backtrace "Print a backtrace from the caller to the bottom of the stack on the Transcript" thisContext parentContext backtraceOn: Transcript ! backtraceOn: aStream "Print a backtrace from the caller to the bottom of the stack on aStream" thisContext parentContext backtraceOn: aStream ! removeLastUnwindPoint "Private - Return and remove the last context marked as an unwind point, or our environment if the last unwind point belongs to another environment." | point environment | environment := thisContext environment. self unwindPoints isEmpty ifTrue: [ ^environment ]. point := self unwindPoints removeLast. ^point value = environment ifTrue: [ point key ] ifFalse: [ environment ]. ! lastUnwindPoint "Private - Return the last context marked as an unwind point, or our en- vironment if the last unwind point belongs to another environment." | point environment | environment := thisContext environment. self unwindPoints isEmpty ifTrue: [ ^environment ]. point := self unwindPoints at: self unwindPoints size. ^point value = environment ifTrue: [ point key ] ifFalse: [ environment ]. ! unwind "Return execution to the last context marked as an unwind point, returning nil on that stack." self unwind: nil ! unwind: returnValue "Return execution to the last context marked as an unwind point, returning returnValue on that stack." | point | point := self removeLastUnwindPoint. point isProcess ifTrue: [ Processor terminateActive "Bye bye, we never get past here." ]. thisContext returnTo: point. ^returnValue ! unwindPoints "Answer an OrderedCollection of contexts marked as unwind points." UnwindPoints isNil ifTrue: [ ^UnwindPoints := OrderedCollection new ]. ^UnwindPoints ! ! !ContextPart methodsFor: 'printing'! backtrace "Print a backtrace from the receiver to the bottom of the stack on the Transcript." self backtraceOn: Transcript ! backtraceOn: aStream "Print a backtrace from the caller to the bottom of the stack on aStream." | ctx | ctx := self. [ ctx isNil or: [ ctx isEnvironment ] ] whileFalse: [ ctx printOn: aStream. aStream nl. ctx := ctx parentContext ] ! ! !ContextPart methodsFor: 'accessing'! client "Answer the client of this context, that is, the object that sent the message that created this context. Fail if the receiver has no parent" ^self parentContext receiver ! environment "To create a valid execution environment for the interpreter even before it starts, GST creates a fake context whose selector is nil and which can be used as a marker for the current execution environment. This method answers that context. For processes, it answers the process block itself" | ctx next | ctx := self. [ next := ctx parentContext. ctx isEnvironment | next isNil ] whileFalse: [ ctx := next ]. ^ctx ! initialIP "Answer the value of the instruction pointer when execution starts in the current context" ^0 ! isEnvironment "To create a valid execution environment for the interpreter even before it starts, GST creates a fake context whose selector is nil and which can be used as a marker for the current execution environment. Answer whether the receiver is that kind of context." self subclassResponsibility ! isProcess "Answer whether the receiver represents a process context, i.e. a context created by BlockClosure>>#newProcess. Such a context can be recognized because it has no parent but its flags are different from those of the contexts created by the VM's prepareExecutionEnvironment function." ^self parentContext isNil & self isEnvironment not ! parentContext "Answer the context that called the receiver" ^parent ! ip "Answer the current instruction pointer into the receiver" "This funny implementation thwarts the interpreter's optimizing effort" ^ip yourself ! ip: newIP "Set the instruction pointer for the receiver" "Fixed typing isn't usually good, but this is too important" newIP isSmallInteger ifFalse: [ ^self error: 'invalid new ip' ]. ip := newIP ! size "Answer the number of valid fields for the receiver. Any read access from (self size + 1) to (self basicSize) has undefined results - even crashing" ^self sp ! sp "Answer the current stack pointer into the receiver" "This funny implementation thwarts the interpreter's optimizing effort" ^sp yourself ! validSize "Answer how many elements in the receiver should be inspected" ^self size ! numArgs "Answer the number of arguments passed to the receiver" ^self method numArgs ! numTemps "Answer the number of temporaries used by the receiver" ^self method numTemps ! sp: newSP "Set the stack pointer for the receiver. Storing into the stack pointer is a potentially dangerous thing, so this code tests that sp is effectively a number. Also, since the newly accessible slots may have contained garbage, this method stores nil into any cells that become accessible as a result." newSP isSmallInteger ifFalse: [ ^self error: 'invalid new sp' ]. newSP > sp ifFalse: [ sp := newSP ]. sp + 1 to: newSP do: [ :i | self at: i put: nil ]. sp := newSP ! method "Return the CompiledMethod being executed" ^method ! methodClass "Return the class in which the CompiledMethod being executed is defined" ^self method methodClass ! isBlock "Answer whether the receiver is a block context" self subclassResponsibility ! receiver "Return the receiver (self) for the method being executed" "This funny implementation thwarts the interpreter's optimizing effort" ^receiver yourself ! selector "Return the selector for the method being executed" ^self method selector ! home "Answer the MethodContext to which the receiver refers" self subclassResponsibility ! ! !ContextPart methodsFor: 'exception handling'! mark "Add the receiver as a possible unwind point" ^self class unwindPoints addLast: self -> self environment ! returnTo: aContext "Set the context to which the receiver will return" "Fixed typing isn't usually good, but this is too important" (aContext class superclass == ContextPart) & (aContext notNil) ifFalse: [ ^self error: 'invalid returning context' ]. parent := aContext ! unmark "Remove the receiver from the contexts to which an unwind operation might return" | index | index := self class unwindPoints findLast: [ :each | each key == self ]. index = 0 ifTrue: [ ^self ]. self class unwindPoints size to: index do: [ :i | self class unwindPoints removeLast ] ! !