"
 COPYRIGHT (c) 1993 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.
"

Context subclass:#BlockContext
       instanceVariableNames:''  "do not add instvars here"
       classVariableNames:''
       poolDictionaries:''
       category:'Kernel-Methods'
!

BlockContext comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.14 1995-06-06 03:52:58 claus Exp $
'!

!BlockContext class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 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.
"
!

version
"
$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.14 1995-06-06 03:52:58 claus Exp $
"
!

documentation
"
    BlockContexts represent the stack context objects of blocks. 
    The layout is the same as for other contexts - this class has been added 
    to avoid a flag in an instance variable.
    (has become necessary with cheap blocks, which have no home).

    WARNING: layout and size known by compiler and runtime system - 
	     do not change.
"
! !

!BlockContext methodsFor:'accessing'!

isBlockContext
    "return true, iff the receiver is a BlockContext, false otherwise"

    ^ true
!

methodHome
    "return the method-home for block contexts"

    |con h|

    home isNil ifTrue:[^ nil]. "XXX will change soon"
    home isContext ifFalse:[^ nil]. "copying blocks have no method home"

    con := self.
    h := home.
    [h notNil] whileTrue:[
	con := h.
	h := con home
    ].
    ^ con
!

method
    "return the method in which the current contexts block was created."

    home notNil ifTrue:[^ home method].
    ^ nil
!

home
    "return the immediate home of the receiver.
     normally this is the methodcontext, where the block was created,
     for nested block contexts, this is the surrounding blocks context."

    home isContext ifFalse:[^ nil]. "copying blocks have no home"
    ^ home
!

selector
    "return the selector of the context - which is one of the value
     selectors. This selector is not found in the context, but synthesized."

    |nargs|

    nargs := self numArgs.
    (nargs == 0) ifTrue:[^ #value].
    (nargs == 1) ifTrue:[^ #value:].
    (nargs == 2) ifTrue:[^ #value:value:].
    (nargs == 3) ifTrue:[^ #value:value:value:].
    (nargs == 4) ifTrue:[^ #value:value:value:value:].
    (nargs == 5) ifTrue:[^ #value:value:value:value:value:].
    ^ nil
! !

!BlockContext methodsFor:'printing & storing'!

receiverPrintString
    "return a printString describing the contexts receiver.

     Since this is also used by the debugger(s), be very careful to
     return something useful, even in case internals of the system
     got corrupted ... (i.e. avoid messageNotUnderstood here)"

    |cls who mHome m className 
     sender selSender tryVars possibleBlocks method mWho|

    (home isNil or:[home isContext not]) ifTrue:[
	"
	 mhmh - an optimized blocks context
	 should get the block here, and get the method from
	 that one ...
	 ... but in 2.10.x, there is no easy way to get to the block
	 since that one is not in the context.
	 Starting with 2.11, the new block calling scheme will fix this.
	"

	"temporary kludge - peek into the sender context.
	 If its a do-like method and there is a single block variable 
	 in the args or temporaries, that must be the one.
	 This helps in some cases.
	"
	(sender := self sender) notNil ifTrue:[
	    tryVars := false.
	    (selSender := sender selector) notNil ifTrue:[
		(selSender endsWith:'do:') ifTrue:[
		    tryVars := true.
		] ifFalse:[
		    (selSender endsWith:'Do:') ifTrue:[
			tryVars := true.
		    ]
		]
	    ].
	    tryVars ifTrue:[
		possibleBlocks := sender argsAndVars select:[:v | v isBlock].
		possibleBlocks := possibleBlocks select:[:b | b home isNil].

		possibleBlocks size == 1 ifTrue:[
		    method := possibleBlocks first method.
		    "
		     change the line in the upper-listview
		     according the information we have now
		    "
		    mWho := method who.
		    ^ '[] (optimized) in ' , 
		      (mWho at:1) name , '-' , (mWho at:2).
		].
	    ]
	].

	^ '[] optimized'
    ].

    mHome := self methodHome.
    mHome isNil ifTrue:[
	'BCONTEXT: no methodHome' errorPrintNL.
	^ '[] in ???'
    ].

    "
     kludge to avoid slow search for containing class
    "
    mHome selector == #doIt ifTrue:[
	who := Array with:mHome receiver class
		     with:#doIt
    ] ifFalse:[
	m := mHome method.
	m isNil ifTrue:[
	    'BCONTEXT: no method' errorPrintNL.
	    ^ '[] in ???'
	].
	who := m who.
    ].
    who notNil ifTrue:[
	cls := who at:1
    ] ifFalse:[
	cls := receiver class.
    ].
    className := cls name.
    className isNil ifTrue:[
	'BCONTEXT: nameless class' errorPrintNL.
	className := '???'
    ].
    ^ '[] in ' , className , '-' , mHome selector printString
! !