"======================================================================
|
|   BlockClosure 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 Steve Byrne.
|
| 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 subclass: #BlockClosure
       instanceVariableNames: 'outerContext block receiver'
       classVariableNames: ''
       poolDictionaries: ''
       category: 'Language-Implementation'
!

BlockClosure comment: 
'I am a factotum class.  My instances represent Smalltalk blocks, portions
of executeable code that have access to the environment that they were
declared in, take parameters, and can be passed around as objects to be
executed by methods outside the current class.
Block closures are sent a message to compute their value and create a new
execution context; this property can be used in the construction of
control flow methods.  They also provide some methods that are used in the
creation of Processes from blocks.'!



!BlockClosure class methodsFor: 'instance creation'!

numArgs: args numTemps: temps bytecodes: bytecodes depth: depth literals: literalArray
    "Answer a BlockClosure for a new CompiledBlock that is created using
     the passed parameters.  To make it work, you must put the BlockClosure
     into a CompiledMethod's literals."
    ^self block: (CompiledBlock
	numArgs: args numTemps: temps bytecodes: bytecodes depth: depth literals: literalArray)
!

block: aCompiledBlock
    "Answer a BlockClosure that activates the passed CompiledBlock."
    ^self new block: aCompiledBlock; yourself
! !


!BlockClosure class methodsFor: 'testing'!

isImmediate
    "Answer whether, if x is an instance of the receiver, x copy == x"
    ^true
! !



!BlockClosure methodsFor: 'overriding'!

shallowCopy
    ^self			"We only have one instance"
!

deepCopy
    ^self			"it's about as deep as we need to get"
! !


!BlockClosure methodsFor: 'private'!

asContext: parent
    "Answer a context which will evaluate the receiver without effects on
     the given context's stack (the return value won't be pushed), as
     soon as it becomes the VM's thisContext.
     parent can be nil - in which case reaching the end of the block will
     probably crash Smalltalk.
     Note that the block has no home, so it cannot contain returns."
    | block top |
    block := BlockContext basicNew: 64.
    parent isNil
	ifTrue: [ block initBlock: self ]
	ifFalse: [
	    top := (parent sp == 0)
		ifTrue: [ parent receiver ]
		ifFalse: [ parent at: parent sp ].

	    parent sp: parent sp - 1.
	    block initBlock: [ self value. top ].
	    block returnTo: parent.
	].
    ^block
! !
    

!BlockClosure methodsFor: 'exception handling'!

valueWithUnwind
    "Evaluate the receiver. Any errors caused by the block will cause a
     backtrace, but execution will continue in the method that sent
     #valueWithUnwind, after that call. Example:
	 [ 1 / 0 ] valueWithUnwind.
	 'unwind works!' printNl.

     Important: this method is public, but it is intended to be used in
     very special cases. You should usually rely on #ensure: and #on:do: "
    | result |
    thisContext mark.
    result := self value.
    thisContext unmark.
    ^result
! !


!BlockClosure methodsFor: 'control structures'!

repeat
    "Evaluate the receiver 'forever' (actually until a return is executed
    or the process is terminated)."

    "When the receiver is a block expression, repeat is optimized
     by the compiler"
    [ self value ] repeat
!


whileTrue: aBlock
    "Evaluate the receiver. If it returns true, evaluate aBlock and re-
     start"

    "When the receiver is a block expression, whileTrue: is optimized
     by the compiler"
    [ self value ] whileTrue: [ aBlock value ].
    ^nil
!

whileFalse: aBlock
    "Evaluate the receiver. If it returns false, evaluate aBlock and re-
     start"

    "When the receiver is a block expression, whileFalse: is optimized
     by the compiler"
    [ self value ] whileFalse: [ aBlock value ].
    ^nil
!

whileTrue
    "Evaluate the receiver until it returns false"

    "When the receiver is a block expression, whileTrue is optimized
     by the compiler"
    ^[ self value ] whileTrue
!

whileFalse
    "Evaluate the receiver until it returns true"

    "When the receiver is a block expression, whileFalse is optimized
     by the compiler"
    ^[ self value ] whileFalse
! !



!BlockClosure methodsFor: 'multiple process'!

fork
    "Create a new process executing the receiver and start it"
    ^self newProcess resume; yourself
!

forkAt: priority
    "Create a new process executing the receiver with given priority
     and start it"
    ^(self newProcess priority: priority) resume; yourself
!

newProcess
    "Create a new process executing the receiver in suspended state.
     The priority is the same as for the calling process. The receiver
     must not contain returns"
    | closure |
    closure := [ self value.
    	      Processor terminateActive ].
    ^Process
	on: (closure asContext: nil)
	at: Processor activePriority
!

newProcessWith: anArray
    "Create a new process executing the receiver with the passed
     arguments, and leave it in suspended state. The priority is
     the same as for the calling process. The receiver must not
     contain returns"
    | closure |
    closure := [ self valueWithArguments: anArray.
    	      Processor terminateActive ].
    ^Process
	on: (closure asContext: nil)
	at: Processor activePriority
! !



!BlockClosure methodsFor: 'testing'!

hasMethodReturn
    "Answer whether the block contains a method return"
    ^self method
	hasBytecode: 124
	between: self initialIP
	and: self finalIP
!


!BlockClosure methodsFor: 'accessing'!

fixTemps
    "This should fix the values of the temporary variables used in the
    block that are ordinarily shared with the method in which the block
    is defined.  Not defined yet, but it is not harmful that it isn't.
    Answer the receiver."
    ^self
!

block
    "Answer the CompiledBlock which contains the receiver's bytecodes"
    ^block
!

block: aCompiledBlock
    "Set the CompiledBlock which contains the receiver's bytecodes"
    block := aCompiledBlock
!

finalIP
    "Answer the last instruction that can be executed by the receiver"
    ^self block size
!

initialIP
    "Answer the initial instruction pointer into the receiver."
    ^1
!

numArgs
    "Answer the number of arguments passed to the receiver"
    ^block numArgs
!

numTemps
    "Answer the number of temporary variables used by the receiver"
    ^block numTemps
!

stackDepth
    "Answer the number of stack slots needed for the receiver"
    ^block stackDepth
!

method
    "Answer the CompiledMethod in which the receiver lies"
    ^block method
!

receiver
    "Answer the object that is used as `self' when executing the receiver
     (if nil, it might mean that the receiver is not valid though...)"
    ^receiver
!

receiver: anObject
    "Set the object that is used as `self' when executing the receiver"
    receiver := anObject
!

outerContext
    "Answer the method/block context which is the immediate outer of
     the receiver"
    ^outerContext
!

outerContext: containingContext
    "Set the method/block context which is the immediate outer of
     the receiver"
    outerContext := containingContext
! !
