'From Cuis 2.5 of 9 August 2010 [latest update: #534] on 10 August 2010 at 10:04:48 am'!

!BlockContext commentStamp: 'jmv 8/10/2010 10:04' prior: 0!
Replaced almost everywhere by BlockClosure!!

My instances function similarly to instances of MethodContext, but they hold the dynamic state for execution of a block in Smalltalk. They access all temporary variables and the method sender via their home pointer, so that those values are effectively shared. Their indexable part is used to store their independent value stack during execution.
	
My instance must hold onto its home in order to work. This can cause circularities if the home is also pointing (via a temp, perhaps) to the instance. In the rare event that this happens (as in SortedCollection sortBlock:) the message fixTemps will replace home with a copy of home, thus defeating the sharing of temps but, nonetheless, eliminating the circularity.

BlockContexts must only be created using the method newForMethod:.  Note that it is impossible to determine the real object size of a BlockContext except by asking for the frameSize of its method.  Any fields above the stack pointer (stackp) are truly invisible -- even (and especially!!) to the garbage collector.  Any store into stackp other than by the primitive method stackp: is potentially fatal.!


!BlockContext methodsFor: 'initialize-release' stamp: 'ajh 7/18/2003 21:49'!
privRefresh
	"Reinitialize the receiver so that it is in the state it was at its creation."

	pc := startpc.
	self stackp: 0.
	nargs timesRepeat: [  "skip arg popping"
		self nextInstruction selector = #popIntoTemporaryVariable:
			ifFalse: [self halt: 'unexpected bytecode instruction']
	].
! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 5/28/2008 10:43'!
activeHome
	"Search senders for the home context.  If the home
	 context is not found on the sender chain answer nil."
	^self caller findContextSuchThat: [:ctxt | ctxt = home]! !

!BlockContext methodsFor: 'accessing' stamp: 'RAH 4/25/2000 19:49'!
argumentCount
	"Answers the number of arguments needed to evaluate the receiver."
	#Valuable.
	^ self numArgs! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 5/29/2008 13:14'!
caller
	^sender! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 5/24/2008 11:20'!
closureHome
	"Answer the context from which an ^-return should return from."

	^self home! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 6/15/2008 11:32'!
contextForLocalVariables
	"Answer the context in which local variables (temporaries) are stored."

	^home! !

!BlockContext methodsFor: 'accessing' stamp: 'di 9/9/2000 10:44'!
copyForSaving
	"Fix the values of the temporary variables used in the block that are 
	ordinarily shared with the method in which the block is defined."

	home := home copy.
	home swapSender: nil! !

!BlockContext methodsFor: 'accessing'!
fixTemps
	"Fix the values of the temporary variables used in the block that are 
	ordinarily shared with the method in which the block is defined."

	home := home copy.
	home swapSender: nil! !

!BlockContext methodsFor: 'accessing' stamp: 'md 4/27/2006 15:14'!
hasInstVarRef
	"Answer whether the receiver references an instance variable."

	| method scanner end printer |

	home ifNil: [^false].
	method := self method.
	end := self endPC.
	scanner := InstructionStream new method: method pc: startpc.
	printer := InstVarRefLocator new.

	[scanner pc <= end] whileTrue: [
		(printer interpretNextInstructionUsing: scanner) ifTrue: [^true].
	].
	^false! !

!BlockContext methodsFor: 'accessing'!
hasMethodReturn
	"Answer whether the receiver has a return ('^') in its code."

	| method scanner end |
	method := self method.
	"Determine end of block from long jump preceding it"
	end := (method at: startpc-2)\\16-4*256 + (method at: startpc-1) + startpc - 1.
	scanner := InstructionStream new method: method pc: startpc.
	scanner scanFor: [:byte | (byte between: 120 and: 124) or: [scanner pc > end]].
	^scanner pc <= end! !

!BlockContext methodsFor: 'accessing'!
home
	"Answer the context in which the receiver was defined."

	^home! !

!BlockContext methodsFor: 'accessing' stamp: 'ajh 1/21/2003 13:16'!
isBlock

	^ true! !

!BlockContext methodsFor: 'accessing' stamp: 'ajh 1/31/2003 12:12'!
isExecutingBlock

	^ true! !

!BlockContext methodsFor: 'accessing'!
method
	"Answer the compiled method in which the receiver was defined."

	^home method! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 6/15/2008 11:33'!
methodReturnContext
	"Answer the context from which an ^-return should return from."

	^home! !

!BlockContext methodsFor: 'accessing' stamp: 'mdr 4/10/2001 10:34'!
numArgs
	"Answer the number of arguments that must be used to evaluate this block"

	^nargs! !

!BlockContext methodsFor: 'accessing'!
receiver 
	"Refer to the comment in ContextPart|receiver."

	^home receiver! !

!BlockContext methodsFor: 'accessing' stamp: 'ajh 1/30/2003 15:45'!
reentrant
	"Copy before calling so multiple activations can exist"

	^ self copy! !

!BlockContext methodsFor: 'accessing'!
tempAt: index 
	"Refer to the comment in ContextPart|tempAt:."

	^home at: index! !

!BlockContext methodsFor: 'accessing'!
tempAt: index put: value 
	"Refer to the comment in ContextPart|tempAt:put:."

	^home at: index put: value! !

!BlockContext methodsFor: 'controlling' stamp: 'jf 9/3/2003 16:45'!
doWhileFalse: conditionBlock
	"Evaluate the receiver once, then again as long the value of conditionBlock is false."
 
	| result |
	[result := self value.
	conditionBlock value] whileFalse.

	^ result! !

!BlockContext methodsFor: 'controlling' stamp: 'jf 9/3/2003 16:39'!
doWhileTrue: conditionBlock
	"Evaluate the receiver once, then again as long the value of conditionBlock is true."
 
	| result |
	[result := self value.
	conditionBlock value] whileTrue.

	^ result! !

!BlockContext methodsFor: 'controlling' stamp: 'sma 5/12/2000 13:22'!
repeat
	"Evaluate the receiver repeatedly, ending only if the block explicitly returns."

	[self value. true] whileTrue! !

!BlockContext methodsFor: 'controlling' stamp: 'ls 9/24/1999 09:45'!
repeatWithGCIf: testBlock
	| ans |
	"run the receiver, and if testBlock returns true, garbage collect and run the receiver again"
	ans := self value.
	(testBlock value: ans) ifTrue: [ Smalltalk garbageCollect. ans := self value ].
	^ans! !

!BlockContext methodsFor: 'controlling'!
whileFalse
	"Ordinarily compiled in-line, and therefore not overridable.
	This is in case the message is sent to other than a literal block.
	Evaluate the receiver, as long as its value is false."
 
	^ [self value] whileFalse: []! !

!BlockContext methodsFor: 'controlling'!
whileFalse: aBlock 
	"Ordinarily compiled in-line, and therefore not overridable.
	This is in case the message is sent to other than a literal block.
	Evaluate the argument, aBlock, as long as the value of the receiver is false."

	^ [self value] whileFalse: [aBlock value]! !

!BlockContext methodsFor: 'controlling'!
whileTrue
	"Ordinarily compiled in-line, and therefore not overridable.
	This is in case the message is sent to other than a literal block.
	Evaluate the receiver, as long as its value is true."
 
	^ [self value] whileTrue: []! !

!BlockContext methodsFor: 'controlling'!
whileTrue: aBlock 
	"Ordinarily compiled in-line, and therefore not overridable.
	This is in case the message is sent to other than a literal block.
	Evaluate the argument, aBlock, as long as the value of the receiver is true."

	^ [self value] whileTrue: [aBlock value]! !

!BlockContext methodsFor: 'evaluating' stamp: 'cmm 2/16/2003 16:08'!
bench
	"See how many times I can value in 5 seconds.  I'll answer a meaningful description."

	| startTime endTime count |
	count := 0.
	endTime := Time millisecondClockValue + 5000.
	startTime := Time millisecondClockValue.
	[ Time millisecondClockValue > endTime ] whileFalse: [ self value.  count := count + 1 ].
	endTime := Time millisecondClockValue.
	^count = 1
		ifTrue: [ ((endTime - startTime) // 1000) printString, ' seconds.' ]
		ifFalse:
			[ ((count * 1000) / (endTime - startTime)) asFloat printString, ' per second.' ]! !

!BlockContext methodsFor: 'evaluating' stamp: 'brp 9/25/2003 13:49'!
durationToRun
	"Answer the duration taken to execute this block."

	^ Duration milliSeconds: self timeToRun

! !

!BlockContext methodsFor: 'evaluating' stamp: 'ajh 1/13/2002 13:36'!
ifError: errorHandlerBlock
	"Evaluate the block represented by the receiver, and normally return it's value.  If an error occurs, the errorHandlerBlock is evaluated, and it's value is instead returned.  The errorHandlerBlock must accept zero, one, or two parameters (the error message and the receiver)."
	"Examples:
		[1 whatsUpDoc] ifError: [:err :rcvr | 'huh?'].
		[1 / 0] ifError: [:err :rcvr |
			'ZeroDivide' = err
				ifTrue: [Float infinity]
				ifFalse: [self error: err]]
"

	^ self on: Error do: [:ex |
		errorHandlerBlock valueWithPossibleArgs: {ex description. ex receiver}]! !

!BlockContext methodsFor: 'evaluating' stamp: 'jm 6/3/1998 14:25'!
timeToRun
	"Answer the number of milliseconds taken to execute this block."

	^ Time millisecondsToRun: self
! !

!BlockContext methodsFor: 'evaluating'!
value
	"Primitive. Evaluate the block represented by the receiver. Fail if the 
	block expects any arguments or if the block is already being executed. 
	Optional. No Lookup. See Object documentation whatIsAPrimitive."

	<primitive: 81>
	^self valueWithArguments: #()! !

!BlockContext methodsFor: 'evaluating'!
value: arg 
	"Primitive. Evaluate the block represented by the receiver. Fail if the 
	block expects other than one argument or if the block is already being 
	executed. Optional. No Lookup. See Object documentation 
	whatIsAPrimitive."

	<primitive: 81>
	^self valueWithArguments: (Array with: arg)! !

!BlockContext methodsFor: 'evaluating'!
value: arg1 value: arg2 
	"Primitive. Evaluate the block represented by the receiver. Fail if the 
	block expects other than two arguments or if the block is already being 
	executed. Optional. See Object documentation whatIsAPrimitive."

	<primitive: 81>
	^self valueWithArguments: (Array with: arg1 with: arg2)! !

!BlockContext methodsFor: 'evaluating'!
value: arg1 value: arg2 value: arg3 
	"Primitive. Evaluate the block represented by the receiver. Fail if the 
	block expects other than three arguments or if the block is already being 
	executed. Optional. See Object documentation whatIsAPrimitive."

	<primitive: 81>
	^self valueWithArguments: 
		(Array
			with: arg1
			with: arg2
			with: arg3)! !

!BlockContext methodsFor: 'evaluating' stamp: 'di 11/30/97 09:19'!
value: arg1 value: arg2 value: arg3 value: arg4 
	"Primitive. Evaluate the block represented by the receiver. Fail if the 
	block expects other than three arguments or if the block is already being 
	executed. Optional. See Object documentation whatIsAPrimitive."

	<primitive: 81>
	^self valueWithArguments: 
		(Array
			with: arg1
			with: arg2
			with: arg3
			with: arg4)! !

!BlockContext methodsFor: 'evaluating' stamp: 'jrp 10/10/2004 22:28'!
valueSupplyingAnswer: anObject

	^ (anObject isCollection and: [anObject isString not])
		ifTrue: [self valueSupplyingAnswers: {anObject}]
		ifFalse: [self valueSupplyingAnswers: {{'*'. anObject}}]! !

!BlockContext methodsFor: 'evaluating' stamp: 'nice 1/1/2010 22:04'!
valueSupplyingAnswers: aListOfPairs
	"evaluate the block using a list of questions / answers that might be called upon to
	automatically respond to Object>>confirm: or FillInTheBlank requests"

	^ [self value] 
		on: ProvideAnswerNotification
		do: 
			[:notify | | answer caption |
			
			caption := notify messageText withSeparatorsCompacted. "to remove new lines"
			answer := aListOfPairs
				detect: 
					[:each | caption = each first
						or: [(caption includesSubstring: each first caseSensitive: false)
						or: [each first match: caption]]]
					ifNone: [nil].
			answer
				ifNotNil: [notify resume: answer second]
				ifNil: 
					[ | outerAnswer |
					outerAnswer := ProvideAnswerNotification signal: notify messageText.
					outerAnswer 
						ifNil: [notify resume] 
						ifNotNil: [notify resume: outerAnswer]]]! !

!BlockContext methodsFor: 'evaluating' stamp: 'jrp 10/10/2004 22:28'!
valueSuppressingAllMessages

	^ self valueSuppressingMessages: #('*')! !

!BlockContext methodsFor: 'evaluating' stamp: 'jrp 10/4/2004 18:59'!
valueSuppressingMessages: aListOfStrings

	^ self
		valueSuppressingMessages: aListOfStrings
		supplyingAnswers: #()! !

!BlockContext methodsFor: 'evaluating' stamp: 'jrp 10/4/2004 18:58'!
valueSuppressingMessages: aListOfStrings supplyingAnswers: aListOfPairs

	^ self valueSupplyingAnswers: aListOfPairs, (aListOfStrings collect: [:each | {each. true}])! !

!BlockContext methodsFor: 'evaluating' stamp: 'md 7/30/2005 21:22'!
valueWithArguments: anArray 
	"Primitive. Evaluate the block represented by the receiver. The argument 
	is an Array whose elements are the arguments for the block. Fail if the 
	length of the Array is not the same as the the number of arguments that 
	the block was expecting. Fail if the block is already being executed. 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 82>

	anArray isArray ifFalse: [^self error: 'valueWithArguments: expects an array'].
	self numArgs = anArray size
		ifTrue: [self error: 'Attempt to evaluate a block that is already being evaluated.']
		ifFalse: [self error: 
			'This block accepts ' ,self numArgs printString, ' argument', (self numArgs = 1 ifTrue:[''] ifFalse:['s']) , 
			', but was called with ', anArray size printString, '.']

! !

!BlockContext methodsFor: 'evaluating' stamp: 'nk 3/11/2001 11:49'!
valueWithEnoughArguments: anArray
	"call me with enough arguments from anArray"
	| args |
	(anArray size == self numArgs)
		ifTrue: [ ^self valueWithArguments: anArray ].

	args := Array new: self numArgs.
	args replaceFrom: 1
		to: (anArray size min: args size)
		with: anArray
		startingAt: 1.

	^ self valueWithArguments: args! !

!BlockContext methodsFor: 'evaluating' stamp: 'md 3/28/2006 20:17'!
valueWithExit 
	  self value: [ ^nil ]! !

!BlockContext methodsFor: 'evaluating' stamp: 'md 10/7/2004 15:24'!
valueWithPossibleArgs: anArray 

     "Evaluate the block represented by the receiver. 
     If the block requires arguments, take them from anArray. If anArray is too
     large, the rest is ignored, if it is too small, use nil for the other arguments"
 
	self numArgs = 0 ifTrue: [^self value].
	self numArgs = anArray size ifTrue: [^self valueWithArguments: anArray].
	self numArgs > anArray size ifTrue: [
		^self valueWithArguments: anArray,
				(Array new: (self numArgs - anArray size))
	].
	^self valueWithArguments: (anArray copyFrom: 1 to: self numArgs)

! !

!BlockContext methodsFor: 'evaluating' stamp: 'md 10/7/2004 15:26'!
valueWithPossibleArgument: anArg 

     "Evaluate the block represented by the receiver. 
     If the block requires one argument, use anArg, if it requires more than one,
     fill up the rest with nils."

	self numArgs = 0 ifTrue: [^self value].
	self numArgs = 1 ifTrue: [^self value: anArg].
	self numArgs  > 1 ifTrue: [^self valueWithArguments: {anArg}, (Array new: self numArgs  - 1)]! !

!BlockContext methodsFor: 'evaluating' stamp: 'ar 8/17/2007 13:15'!
valueWithin: aDuration onTimeout: timeoutBlock
	"Evaluate the receiver.
	If the evaluation does not complete in less than aDuration evaluate the timeoutBlock instead"

	| theProcess delay watchdog |

	aDuration <= Duration zero ifTrue: [^ timeoutBlock value ].

	"the block will be executed in the current process"
	theProcess := Processor activeProcess.
	delay := aDuration asDelay.

	"make a watchdog process"
	watchdog := [
		delay wait. 	"wait for timeout or completion"
		theProcess ifNotNil:[ theProcess signalException: TimedOut ] 
	] newProcess.

	"Watchdog needs to run at high priority to do its job (but not at timing priority)"
	watchdog priority: Processor timingPriority-1.

	"catch the timeout signal"
	^ [	watchdog resume.				"start up the watchdog"
		self ensure:[						"evaluate the receiver"
			theProcess := nil.				"it has completed, so ..."
			delay delaySemaphore signal.	"arrange for the watchdog to exit"
		]] on: TimedOut do: [ :e | timeoutBlock value ].
! !

!BlockContext methodsFor: 'exceptions' stamp: 'sma 5/11/2000 19:38'!
assert
	self assert: self! !

!BlockContext methodsFor: 'exceptions' stamp: 'ar 12/4/2009 18:31'!
ensure: aBlock
	"Evaluate a termination block after evaluating the receiver, regardless of
	 whether the receiver's evaluation completes.  N.B.  This method is *not*
	 implemented as a primitive.  Primitive 198 always fails.  The VM uses prim
	 198 in a context's method as the mark for an ensure:/ifCurtailed: activation."

	| complete returnValue |
	<primitive: 198>
	returnValue := self value.
	complete ifNil:[
		complete := true.
		aBlock value.
	].
	^ returnValue! !

!BlockContext methodsFor: 'exceptions' stamp: 'ar 12/4/2009 18:41'!
ifCurtailed: aBlock
	"Evaluate the receiver with an abnormal termination action.
	 Evaluate aBlock only if execution is unwound during execution
	 of the receiver.  If execution of the receiver finishes normally do
	 not evaluate aBlock.  N.B.  This method is *not* implemented as a
	 primitive.  Primitive 198 always fails.  The VM uses prim 198 in a
	 context's method as the mark for an ensure:/ifCurtailed: activation."
	| complete result |
	<primitive: 198>
	result := self value.
	complete := true.
	^result! !

!BlockContext methodsFor: 'exceptions' stamp: 'ar 3/6/2001 14:25'!
on: exception do: handlerAction
	"Evaluate the receiver in the scope of an exception handler."
	| handlerActive |
	<primitive: 199>
	handlerActive := true.
	^self value! !

!BlockContext methodsFor: 'exceptions' stamp: 'brp 12/20/2009 19:34'!
on: exc1 do: block1 on: exc2 do: block2

	^[
		[ self value ]
			on: exc1
			do: block1 ]

		on: exc2
		do: block2! !

!BlockContext methodsFor: 'exceptions' stamp: 'brp 12/20/2009 19:35'!
on: exc1 do: block1 on: exc2 do: block2 on: exc3 do: block3

	^[
		[ self value ]
			on: exc1
			do: block1 ]

		on: exc2
		do: block2

		on: exc3
		do: block3! !

!BlockContext methodsFor: 'exceptions' stamp: 'ajh 10/9/2001 16:51'!
onDNU: selector do: handleBlock
	"Catch MessageNotUnderstood exceptions but only those of the given selector (DNU stands for doesNotUnderstand:)"

	^ self on: MessageNotUnderstood do: [:exception |
		exception message selector = selector
			ifTrue: [handleBlock valueWithPossibleArgs: {exception}]
			ifFalse: [exception pass]
	  ]! !

!BlockContext methodsFor: 'exceptions' stamp: 'ajh 1/24/2003 21:53'!
valueUninterruptably
	"Temporarily make my home Context unable to return control to its sender, to guard against circumlocution of the ensured behavior."

	^ self ifCurtailed: [^ self]! !

!BlockContext methodsFor: 'instruction decoding' stamp: 'ajh 1/24/2003 16:35'!
blockReturnTop
	"Simulate the interpreter's action when a ReturnTopOfStack bytecode is 
	encountered in the receiver."

	| save dest |
	save := home.	"Needed because return code will nil it"
	dest := self return: self pop from: self.
	home := save.
	sender := nil.
	^ dest! !

!BlockContext methodsFor: 'printing' stamp: 'md 2/22/2006 15:53'!
decompile
	^ home method decompilerClass new decompileBlock: self! !

!BlockContext methodsFor: 'printing' stamp: 'md 2/20/2006 13:46'!
decompileString
	^self decompile decompileString.! !

!BlockContext methodsFor: 'printing' stamp: 'eem 7/28/2008 14:10'!
fullPrintOn: aStream
	aStream print: self; cr.
	(self decompile ifNil: ['--source missing--']) printOn: aStream indent: 0! !

!BlockContext methodsFor: 'printing' stamp: 'eem 5/16/2008 12:03'!
printOn: aStream
	| decompilation blockString truncatedBlockString |

	home == nil ifTrue: [^aStream nextPutAll: 'a BlockContext with home=nil'].
	aStream nextPutAll: '[] in '.
	super printOn: aStream.
	decompilation := [self decompile ifNil: ['--source missing--']]
						on: Error
						do: [:ex| ' (error in decompilation)'].
	blockString := ((decompilation isString
					ifTrue: [decompilation]
					ifFalse: [decompilation printString])
						replaceAll: Character cr with: Character space)
							replaceAll: Character tab with: Character space.
	truncatedBlockString := blockString truncateWithElipsisTo: 80.
	truncatedBlockString size < blockString size ifTrue:
		[truncatedBlockString := truncatedBlockString, ']}'].
	aStream space; nextPutAll: truncatedBlockString! !

!BlockContext methodsFor: 'printing' stamp: 'MPW 1/1/1901 22:01'!
printOnStream: aStream

	home == nil ifTrue: [^aStream print: 'a BlockContext with home=nil'].
	aStream print: '[] in '.
	super printOnStream: aStream! !

!BlockContext methodsFor: 'scheduling' stamp: 'ajh 2/10/2003 14:23'!
asContext

	^ self! !

!BlockContext methodsFor: 'scheduling' stamp: 'di 9/12/1998 11:53'!
fork
	"Create and schedule a Process running the code in the receiver."

	^ self newProcess resume! !

!BlockContext methodsFor: 'scheduling' stamp: 'ajh 10/16/2002 11:14'!
forkAndWait
	"Suspend current process and execute self in new process, when it completes resume current process"

	| semaphore |
	semaphore := Semaphore new.
	[self ensure: [semaphore signal]] fork.
	semaphore wait.
! !

!BlockContext methodsFor: 'scheduling' stamp: 'jm 11/9/1998 10:16'!
forkAt: priority 
	"Create and schedule a Process running the code in the receiver at the given priority. Answer the newly created process."

	| forkedProcess |
	forkedProcess := self newProcess.
	forkedProcess priority: priority.
	^ forkedProcess resume
! !

!BlockContext methodsFor: 'scheduling' stamp: 'svp 6/23/2003 10:59'!
forkAt: priority named: name
	"Create and schedule a Process running the code in the receiver at the
	given priority and having the given name. Answer the newly created 
	process."

	| forkedProcess |
	forkedProcess := self newProcess.
	forkedProcess priority: priority.
	forkedProcess name: name.
	^ forkedProcess resume! !

!BlockContext methodsFor: 'scheduling' stamp: 'svp 6/23/2003 10:59'!
forkNamed: aString
	"Create and schedule a Process running the code in the receiver and
	having the given name."

	^ self newProcess name: aString; resume! !

!BlockContext methodsFor: 'scheduling' stamp: 'ajh 2/10/2003 14:25'!
newProcess
	"Answer a Process running the code in the receiver. The process is not 
	scheduled."
	<primitive: 19> "Simulation guard"
	^Process
		forContext: 
			[self value.
			Processor terminateActive] asContext
		priority: Processor activePriority! !

!BlockContext methodsFor: 'scheduling' stamp: 'ajh 2/10/2003 14:25'!
newProcessWith: anArray 
	"Answer a Process running the code in the receiver. The receiver's block 
	arguments are bound to the contents of the argument, anArray. The 
	process is not scheduled."
	<primitive: 19> "Simulation guard"
	^Process
		forContext: 
			[self valueWithArguments: anArray.
			Processor terminateActive] asContext
		priority: Processor activePriority! !

!BlockContext methodsFor: 'scheduling' stamp: 'sr 6/14/2004 15:19'!
valueAt: blockPriority 
	"Evaluate the receiver (block), with another priority as the actual one 
	and restore it afterwards. The caller should be careful with using 
	higher priorities."
	| activeProcess result outsidePriority |
	activeProcess := Processor activeProcess.
	outsidePriority := activeProcess priority.
	activeProcess priority: blockPriority.
	result := self
				ensure: [activeProcess priority: outsidePriority].
	"Yield after restoring lower priority to give the preempted processes a  
	chance to run."
	blockPriority > outsidePriority
		ifTrue: [Processor yield].
	^ result! !

!BlockContext methodsFor: 'system simulation' stamp: 'di 1/11/1999 10:24'!
pushArgs: args from: sendr 
	"Simulates action of the value primitive."

	args size ~= nargs ifTrue: [^self error: 'incorrect number of args'].
	self stackp: 0.
	args do: [:arg | self push: arg].
	sender := sendr.
	pc := startpc! !

!BlockContext methodsFor: 'system simulation' stamp: 'hmm 7/30/2001 18:03'!
stepToSendOrReturn
	pc = startpc ifTrue: [
		"pop args first"
		self numArgs timesRepeat: [self step]].
	^super stepToSendOrReturn! !

!BlockContext methodsFor: '*services-base' stamp: 'rr 3/21/2006 11:53'!
valueWithRequestor: aRequestor 
	"To do later: make the fillInTheBlank display more informative captions.
	Include the description of the service, and maybe record steps"

	^ self numArgs isZero 
		ifTrue: [self value]
		ifFalse: [self value: aRequestor]! !

!BlockContext methodsFor: 'private' stamp: 'ajh 1/24/2003 20:36'!
aboutToReturn: result through: firstUnwindContext 
	"Called from VM when an unwindBlock is found between self and its home.  Return to home's sender, executing unwind blocks on the way."

	self home return: result! !

!BlockContext methodsFor: 'private' stamp: 'tfei 3/31/1999 17:40'!
cannotReturn: result
	"The receiver tried to return result to a method context that no longer exists."

	| ex newResult |
	ex := BlockCannotReturn new.
	ex result: result.
	newResult := ex signal.
	^newResult! !

!BlockContext methodsFor: 'private' stamp: 'ajh 1/27/2003 21:18'!
copyTo: aContext blocks: dict
	"Copy self and my sender chain down to, but not including, aContext.  End of copied chain will have nil sender.  BlockContexts whose home is also copied will point to the copy.  However, blockContexts that are not on the stack but may be later will not have their home pointing in the new copied thread.  So an error will be raised if one of these tries to return directly to its home."

	| copy |
	self == aContext ifTrue: [^ nil].
	copy := self copy.
	(dict at: self home ifAbsentPut: [OrderedCollection new]) add: copy.
	self sender ifNotNil: [
		copy privSender: (self sender copyTo: aContext blocks: dict)].
	^ copy! !

!BlockContext methodsFor: 'private' stamp: 'md 4/27/2006 15:14'!
endPC
	"Determine end of block from long jump preceding it"
	^(self method at: startpc - 2)
				\\ 16 - 4 * 256
				+ (self method at: startpc - 1) + startpc - 1.! !

!BlockContext methodsFor: 'private' stamp: 'tfei 3/20/2000 00:24'!
hideFromDebugger

	^home ~~ nil and: [home hideFromDebugger]! !

!BlockContext methodsFor: 'private' stamp: 'di 1/14/1999 22:28'!
instVarAt: index put: value
	index = 3 ifTrue: [self stackp: value. ^ value].
	^ super instVarAt: index put: value! !

!BlockContext methodsFor: 'private' stamp: 'ajh 7/7/2004 13:43'!
myEnv
	"polymorphic with MethodContext"

	^ nil! !

!BlockContext methodsFor: 'private' stamp: 'ajh 1/27/2003 21:08'!
privHome: context

	home := context! !

!BlockContext methodsFor: 'private'!
startpc
	"for use by the System Tracer only"

	^startpc! !

!BlockContext methodsFor: 'private'!
valueError

	self error: 'Incompatible number of args, or already active'! !

!BlockContext methodsFor: 'private' stamp: 'ar 3/2/2001 01:16'!
valueUnpreemptively
	"Evaluate the receiver (block), without the possibility of preemption by higher priority processes. Use this facility VERY sparingly!!"
	"Think about using Block>>valueUninterruptably first, and think about using Semaphore>>critical: before that, and think about redesigning your application even before that!! 
	After you've done all that thinking, go right ahead and use it..."
	| activeProcess oldPriority result |
	activeProcess := Processor activeProcess.
	oldPriority := activeProcess priority.
	activeProcess priority: Processor highestPriority.
	result := self ensure: [activeProcess priority: oldPriority].
	"Yield after restoring priority to give the preempted processes a chance to run"
	Processor yield.
	^result! !

