"
 COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Object subclass:#Block
       instanceVariableNames:'code flags byteCode home nargs
                              sourcePos initialPC literals
                              selfValue method'
       classVariableNames:'InvalidNewSignal'
       poolDictionaries:''
       category:'Kernel-Methods'
!

Block comment:'

COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Block.st,v 1.11 1994-02-25 12:54:31 claus Exp $

written spring 89 by claus
'!

!Block class methodsFor:'documentation'!

documentation
"
Blocks are pieces of executable code which can be evaluated by sending
them a value-message (''value'', ''value:'', ''value:value:'' etc).

Blocks with arguments need a message of type ''value:arg1 ... value:argn''
for evaluation; the number of arguments passed when evaluating must match
the number of arguments the block was declared with otherwise an error is
raised. Blocks without args need a ''value'' message for evaluation.

Blocks keep a reference to the method context where the block was declared -
this allows blocks to access the methods arguments and/or variables.
This is also true when the method has already returned - since the
block keeps this reference, the methods context will NOT die in this case.

A return (via ^-statement) out of a block will force a return from the
blocks method context (if it is still living) - this make the implementation
of long-jumps and control structures possible.
(If the method is not alive (i.e. has already returned), a return out of the block 
is ignored and a simple return from the block is performed).

Long-jump is done by defining a catchBlock as ''[^ self]''
somewhere up in the calling-tree. Then, to do the long-jump from out of some 
deeply nested method, simply do: ''catchBlock value''.

Instance variables:

code        <not_an_object>   the function pointer if its a compiled block
flags       <SmallInteger>    special flag bits coded in a number
byteCode    <ByteArray>       bytecode of home method if its an interpreted block
home        <Context>         the context where this block was created (i.e. defined)
                              this may be a BlockContext or a methodContext
nargs       <SmallInteger>    the number of arguments the block expects
sourcePos   <SmallInteger>    the character poistion of its source, in chars
                              relative to methods source beginning
initialPC   <SmallInteger>    the start position within the byteCode
                              for compiled blocks, this is nil.
literals    <Array>           the blocks literal array
selfValue   <Object>          value to use for self if its a copying block
method      <Method>          method where block was created (cheap blocks only)

NOTICE: layout known by runtime system and compiler - do not change
"
! !

!Block class methodsFor:'initialization' !

initialize
    "setup the signals"

    InvalidNewSignal isNil ifTrue:[
        InvalidNewSignal := (Signal new).
        InvalidNewSignal mayProceed:false.
        InvalidNewSignal notifierString:'blocks are only created by the system'.
    ]
! !

!Block class methodsFor:'queries'!

isBuiltInClass
    "this class is known by the run-time-system"

    ^ true
! !

!Block class methodsFor:'instance creation'!

code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:sourcePos initialPC:initialPC literals:literals dynamic:dynamic
    "create a new cheap (homeless) block.
     Not for public use - special hook for the compiler."

    |newBlock|

    newBlock := super basicNew code:codeAddress 
                           byteCode:bCode
                              nargs:numArgs
                     sourcePosition:sourcePos
                          initialPC:initialPC
                           literals:literals
                            dynamic:dynamic.
    ^ newBlock
!

new
    "catch creation of blocks - only the system creates blocks"

    InvalidNewSignal raise.
    ^ nil
!

new:size
    "catch creation of blocks - only the system creates blocks"

    InvalidNewSignal raise.
    ^ nil
! !

!Block methodsFor:'testing'!

isBlock
    "return true, if this is a block - yes I am"

    ^ true
! !

!Block methodsFor:'accessing'!

instVarAt:index
    "have to catch instVar access to code - since its no object"

    (index == 1) ifTrue:[^ self code].
    ^ super instVarAt:index
!

instVarAt:index put:value
    "have to catch instVar access to code - since its no object"

    (index == 1) ifTrue:[^ self code:value].
    ^ super instVarAt:index put:value
!

code
    "return the code field. This is not an object but the address of the machine instructions. 
     Therefore an integer representing the code-address is returned"

%{  /* NOCONTEXT */

    if (_INST(code) != nil) {
        RETURN ( _MKSMALLINT((int)(_INST(code))) )
    }
%}
.
    ^ nil
!

byteCode
    "return the bytecode (a ByteArray) of the block"

    ^ byteCode
!

nargs
    "return the number of arguments I expect for evaluation"

    ^ nargs
!

selfValue
    "return the copied self"

    ^ selfValue
! !

!Block methodsFor:'private accessing'!

code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:srcPos initialPC:iPC literals:lits dynamic:dynamic
    "set all relevant internals"

    self code:codeAddress.
    byteCode := bCode.
    nargs := numArgs.
    sourcePos := srcPos.
    initialPC := iPC.
    literals := lits.
    self dynamic:dynamic
!

code:anAddress
    "set the code field - DANGER ALERT. 
     This is not an object but the address of the blocks machine instructions.
     Therefore the argument must be an integer representing this address.
     You can crash Smalltalk very badly when playing around here ...
     This method is for compiler support and very special cases (debugging) only
     - do not use"

%{  /* NOCONTEXT */
    if (_isSmallInteger(anAddress))
        _INST(code) = (OBJ)(_intVal(anAddress));
    else
        _INST(code) = (OBJ)0;
%}
!

byteCode:aByteArray
    "set the bytecode field - DANGER ALERT"

    byteCode := aByteArray
!

nargs:numArgs
    "set the number of arguments I expect for evaluation - DANGER ALERT"

    nargs := numArgs
!

sourcePosition:position 
    "set the position of the source within my method"

    sourcePos := position
!

initialPC:initial 
    "set the initial pc for evaluation - DANGER ALERT"

    initialPC := initial
!

literals:aLiteralArray 
    "set the literal array for evaluation - DANGER ALERT"

    literals := aLiteralArray
!

dynamic:aBoolean
    "set the flag bit stating that the machine code was created
     dynamically and should be flushed on image-restart.
     Obsolete - now done in VM"

%{  /* NOCONTEXT */
    int newFlags = _intVal(_INST(flags));

    /* made this a primitive to get define in stc.h */
    if (aBoolean == true)
        newFlags |= F_DYNAMIC;
    else
        newFlags &= ~F_DYNAMIC;

    _INST(flags) = _MKSMALLINT(newFlags);
%}
! !

!Block methodsFor:'error handling'!

argumentCountError:numberGiven
    "report that the number of arguments given does not match the number expected"

    self error:('Block got ' , numberGiven printString ,
                ' args while ' , nargs printString , ' where expected')
!

invalidMethod
    "this is sent by the bytecode interpreter when the blocks definition is bad
     (bad literal array, missing bytecodes etc).
     Can only happen when playing around with the blocks instvars (literal array)
     or the Compiler/runtime system is buggy"

    self error:'invalid block - not executable'
!

invalidByteCode
    "this is sent by the bytecode interpreter when trying to execute
     an invalid bytecode.
     Can only happen when playing around with the blocks instvars (byteCode)
     or the Compiler/runtime system is buggy"

    self error:'invalid byteCode in block - not executable'
!

receiverNotBoolean
    "this error is triggered when the bytecode-interpreter tries to
     execute ifTrue:/ifFalse or whileTrue: type of expressions where the
     receiver is neither true nor false."

    self error:'if/while on non-boolean receiver'
! !

!Block methodsFor:'evaluation'!

value
    "evaluate the receiver with no block args. The receiver must be a block without arguments."

%{  /* NOCONTEXT */

    REGISTER OBJFUNC thecode;
    OBJ home;
    extern OBJ interpret();

    if (_INST(nargs) == _MKSMALLINT(0)) {
#if defined(THIS_CONTEXT)
        if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
            _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
        thecode = _BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
        if (thecode != (OBJFUNC)nil) {
            /* compiled machine code */
            RETURN ( (*thecode)(self, COMMA_SND) );
        }
        /* interpreted code */
        RETURN ( interpret(self, 0, nil, nil COMMA_SND, nil) );
#else
        home = _BlockInstPtr(self)->b_home;
        if (thecode != (OBJFUNC)nil) {
            /* compiled machine code */
            RETURN ( (*thecode)(home COMMA_SND) );
        }
        /* interpreted code */
        RETURN ( interpret(self, 0, nil, home COMMA_SND, nil) );
#endif
    }
%}
.
    ^ self argumentCountError:0
!

value:arg
    "evaluate the receiver with one argument. The receiver must be a 1-arg block."

%{  /* NOCONTEXT */

    REGISTER OBJFUNC thecode;
    OBJ home;
    extern OBJ interpret();

    if (_INST(nargs) == _MKSMALLINT(1)) {
#if defined(THIS_CONTEXT)
        if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
            _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
        thecode = _BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(self COMMA_SND, arg) );
        }
        /* interpreted code */
        RETURN ( interpret(self, 1, nil, nil COMMA_SND, nil, arg) );
#else
        home = _BlockInstPtr(self)->b_home;
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(home COMMA_SND, arg) );
        }
        /* interpreted code */
        RETURN ( interpret(self, 1, nil, home COMMA_SND, nil, arg) );
#endif
    }
%}
.
    ^ self argumentCountError:1
!

value:arg1 value:arg2
    "evaluate the receiver with two arguments. The receiver must be a 2-arg block."

%{  /* NOCONTEXT */

    REGISTER OBJFUNC thecode;
    OBJ home;
    extern OBJ interpret();

    if (_INST(nargs) == _MKSMALLINT(2)) {
#if defined(THIS_CONTEXT)
        if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
            _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
        thecode = _BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(self COMMA_SND, arg1, arg2) );
        }
        RETURN ( interpret(self, 2, nil, nil COMMA_SND, nil, arg1, arg2) );
#else
        home = _BlockInstPtr(self)->b_home;
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(home COMMA_SND, arg1, arg2) );
        }
        RETURN ( interpret(self, 2, nil, home COMMA_SND, nil, arg1, arg2) );
#endif
    }
%}
.
    ^ self argumentCountError:2
!

value:arg1 value:arg2 value:arg3
    "evaluate the receiver with three arguments. The receiver must be a 3-arg block."

%{  /* NOCONTEXT */

    REGISTER OBJFUNC thecode;
    OBJ home;
    extern OBJ interpret();

    if (_INST(nargs) == _MKSMALLINT(3)) {
#if defined(THIS_CONTEXT)
        if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
            _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
        thecode = _BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3) );
        }
        RETURN ( interpret(self, 3, nil, nil COMMA_SND, nil, arg1, arg2, arg3) );
#else
        home = _BlockInstPtr(self)->b_home;
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3) );
        }
        RETURN ( interpret(self, 3, nil, home COMMA_SND, nil, arg1, arg2, arg3) );
#endif
    }
%}
.
    ^ self argumentCountError:3
!

value:arg1 value:arg2 value:arg3 value:arg4
    "evaluate the receiver with four arguments. The receiver must be a 4-arg block."

%{  /* NOCONTEXT */

    REGISTER OBJFUNC thecode;
    OBJ home;
    extern OBJ interpret();

    if (_INST(nargs) == _MKSMALLINT(4)) {
#if defined(THIS_CONTEXT)
        if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
            _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
        thecode = _BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4) );
        }
        RETURN ( interpret(self, 4, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4) );
#else
        home = _BlockInstPtr(self)->b_home;
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4) );
        }
        RETURN ( interpret(self, 4, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4) );
#endif
    }
%}
.
    ^ self argumentCountError:4
!

value:arg1 value:arg2 value:arg3 value:arg4 value:arg5
    "evaluate the receiver with four arguments. The receiver must be a 5-arg block."

%{  /* NOCONTEXT */

    REGISTER OBJFUNC thecode;
    OBJ home;
    extern OBJ interpret();

    if (_INST(nargs) == _MKSMALLINT(5)) {
#if defined(THIS_CONTEXT)
        if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
            _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
        thecode = _BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4, arg5) );
        }
        RETURN ( interpret(self, 5, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5) );
#else
        home = _BlockInstPtr(self)->b_home;
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5) );
        }
        RETURN ( interpret(self, 5, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5) );
#endif
    }
%}
.
    ^ self argumentCountError:5
!

value:arg1 value:arg2 value:arg3 value:arg4 value:arg5 value:arg6
    "evaluate the receiver with four arguments. The receiver must be a 6-arg block."

%{  /* NOCONTEXT */

    REGISTER OBJFUNC thecode;
    OBJ home;
    extern OBJ interpret();

    if (_INST(nargs) == _MKSMALLINT(6)) {
#if defined(THIS_CONTEXT)
        if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
            _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
        thecode = _BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4, arg5, arg6) );
        }
        RETURN ( interpret(self, 6, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5, arg6) );
#else
        home = _BlockInstPtr(self)->b_home;
        if (thecode != (OBJFUNC)nil) {
            RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5, arg6) );
        }
        RETURN ( interpret(self, 6, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5, arg6) );
#endif
    }
%}
.
    ^ self argumentCountError:6
!

valueWithArguments:argArray
    "evaluate the receiver with arguments taken from argArray.
     The size of the argArray must match the number of arguments the receiver expects."

    |a1 a2 a3 a4 a5 a6 a7|

    (argArray class == Array) ifFalse:[
        ^ self error:'argument must be an array'
    ].
    (argArray size == nargs) ifFalse:[
        ^ self argumentCountError:(argArray size)
    ].
%{

    REGISTER OBJFUNC thecode;
    OBJ home;
    extern OBJ interpret();

#if defined(THIS_CONTEXT)
    if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)
        _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
    switch (_intVal(_INST(nargs))) {
        default:
            goto error;
        case 7:
            a7 = _ArrayInstPtr(argArray)->a_element[6];
        case 6:
            a6 = _ArrayInstPtr(argArray)->a_element[5];
        case 5:
            a5 = _ArrayInstPtr(argArray)->a_element[4];
        case 4:
            a4 = _ArrayInstPtr(argArray)->a_element[3];
        case 3:
            a3 = _ArrayInstPtr(argArray)->a_element[2];
        case 2:
            a2 = _ArrayInstPtr(argArray)->a_element[1];
        case 1:
            a1 = _ArrayInstPtr(argArray)->a_element[0];
        case 0:
            break;
    }
    thecode = _BlockInstPtr(self)->b_code;
#ifdef NEW_BLOCK_CALL
    if (thecode != (OBJFUNC)nil) {
        RETURN ( (*thecode)(self COMMA_SND, a1, a2, a3, a4, a5, a6, a7) );
    }
    RETURN ( interpret(self, _intVal(_INST(nargs)), nil,
                                    nil COMMA_SND, nil, a1, a2, a3, a4, a5, a6, a7) );
#else
    home = _BlockInstPtr(self)->b_home;
    if (thecode != (OBJFUNC)nil) {
        RETURN ( (*thecode)(home COMMA_SND, a1, a2, a3, a4, a5, a6, a7) );
    }
    RETURN ( interpret(self, _intVal(_INST(nargs)), nil,
                                    home COMMA_SND, nil, a1, a2, a3, a4, a5, a6, a7) );
#endif
error: ;
%}
.
    self error:'only blocks with up-to 7 arguments supported'
!

valueNowOrOnUnwindDo:aBlock
    "evaluate the receiver - after that, or when some method sent within unwinds (i.e. does
     a long return), evaluate the argument, aBlock.
     This is used to make certain that cleanup actions (for example closing files etc.) are
     executed regardless of error actions"

    |v|

    v := self value.       "the real logic is in Context"
    aBlock value.
    ^ v
!

valueOnUnwindDo:aBlock
    "evaluate the receiver - when some method sent within unwinds (i.e. does
     a long return), evaluate the argument, aBlock.
     This is used to make certain that cleanup actions (for example closing files etc.) are
     executed regardless of error actions"

    ^ self value        "the real logic is in Context"
! !

!Block methodsFor:'looping'!

whileTrue:aBlock
    "evaluate the argument, aBlock while the receiver evaluates to true.
     - open coded by compiler but needed here for #perform and expression evaluation."
%{
    extern OBJ _value;
    static struct inlineCache bval = _ILC0;
    static struct inlineCache selfVal = _ILC0;

    while ((*bval.ilc_func)(self, _value, CON_COMMA nil, &bval) == true) {
        if (InterruptPending != nil) interrupt(CONARG);
        (*selfVal.ilc_func)(aBlock, _value, CON_COMMA nil, &selfVal);
    }
%}
.
    ^ nil
!

whileTrue
    "evaluate the receiver until it evaluates to false (ST80 compatibility)"

    ^ self whileTrue:[]
!

whileFalse:aBlock
    "evaluate the argument while the receiver evaluates to false.
     - open coded by compiler but needed here for #perform and expression evaluation."
%{
    extern OBJ _value;
    static struct inlineCache bval = _ILC0;
    static struct inlineCache selfVal = _ILC0;

    while ((*bval.ilc_func)(self, _value, CON_COMMA nil, &bval) == false) {
        if (InterruptPending != nil) interrupt(CONARG);
        (*selfVal.ilc_func)(aBlock, _value, CON_COMMA nil, &selfVal);
    }
%}
.
    ^ nil
!

whileFalse
    "evaluate the receiver until it evaluates to true (ST80 compatibility)"

    ^ self whileFalse:[]
!

doWhile:aBlock
    "repeat the receiver block until aBlock evaluates to false.
     The receiver is evaluated at least once."

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

doUntil:aBlock
    "repeat the receiver block until aBlock evaluates to true.
     The receiver is evaluated at least once."

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

loop
    "repeat the receiver forever (should contain a return somewhere).
     Inspired by a corresponding Self method."

    [true] whileTrue:[self value]

    "[Transcript showCr:'hello'] loop"  "must be stopped with interrupt"
!

valueWithExit
    "the receiver must be a block of one argument.  It is evaluated, and is passed a block,
     which, if sent a value:-message, will exit the receiver block, returning the parameter of the 
     value:-message. Used for premature returns to the caller.
     Taken from a manchester goody (also appears in Self)."

    ^ self value: [:exitValue | ^exitValue]

    "[:exit |
        1 to:10 do:[:i |
            Transcript showCr:i.
            i == 5 ifTrue:[exit value:'thats it']
        ].
        'regular block-value; never returned'
     ] valueWithExit"
!

loopWithExit
    "the receiver must be a block of one argument.  It is evaluated in a loop forever, and is passed a 
     block, which, if sent a value:-message, will exit the receiver block, returning the parameter of 
     the value:-message. Used for loops with exit in the middle.
     Inspired by a corresponding Self method."

    |exitBlock|

    exitBlock := [:exitValue | ^ exitValue].
    [true] whileTrue:[self value:exitBlock]

    "|i|
     i := 1.
     [:exit |
        Transcript showCr:i.
        i == 5 ifTrue:[exit value:'thats it'].
        i := i + 1
     ] loopWithExit"
! !

!Block methodsFor:'process creation'!

newProcess
    "create a new (unscheduled) process executing the receiver"

    |p pBlock startUp|

    startUp := self.
    pBlock := [ startUp value. Processor terminate:p ].
    p := Processor newProcessFor:pBlock.
    ^ p
!

fork
    "create a new process executing the receiver"

    ^ self newProcess resume
!

forkWith:argumentArray
    "create a new process executing the receiver passing elements
     in argumentArray to the receiver block"

    |b|

    b := [self valueWithArguments:argumentArray].
    ^ b fork
!

forkAt:priority
    "create a new process executing the receiver"

    ^ (self newProcess priority:priority) resume
! !

!Block methodsFor:'binary storage'!

readBinaryContentsFrom: stream manager: manager
    "make certain, that only interpreted blocks are created
     this way."

    super readBinaryContentsFrom: stream manager: manager.
    code := nil.
! !

!Block methodsFor:'printing'!

printOn:aStream
    "append a a printed representation of the block to aStream"

    |homeClass receiverClass selector|

    "cheap blocks have no home context, but a method instead"

    (home isNil or:[home isContext not]) ifTrue:[
        aStream nextPutAll:'[] in '.

        method notNil ifTrue:[
            "find out, for which class this Method was for ..."
            receiverClass := method containingClass.
            receiverClass notNil ifTrue:[
                selector := receiverClass selectorForMethod:method.
                aStream nextPutAll:(receiverClass name , '-' , selector).
                aStream nextPutAll:' (optimized)'.
                ^ self
            ].
        ].
        "currently, some cheap blocks don't know where they have been created"
        aStream nextPutAll:' ??? (optimized)'.
        ^ self
    ].

    "a full blown block (with home, but without method)"

    aStream nextPutAll:'[] in '. 
    home receiver class name printOn:aStream.
    aStream nextPut:$-.
    home methodHome selector printOn:aStream.

"
    aStream nextPutAll:'[] in '.
    homeClass := home containingClass.
    homeClass notNil ifTrue:[
        homeClass name printOn:aStream.
        aStream space.
        (homeClass selectorForMethod:home) printOn:aStream
    ] ifFalse:[
        aStream nextPutAll:' ???' 
    ]
"
! !