"
 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.
"

ParseNode subclass:#BlockNode
	instanceVariableNames:'blockArgs statements home inlineBlock exitBlock blockVars
		needsHome lineNr endLineNr blockArgAccessedInBlock numTemp
		maxNumTemp indexOfFirstTemp subBlocks accessedOuterBlockVars
		possiblyInlined'
	classVariableNames:''
	poolDictionaries:''
	category:'System-Compiler-Support'
!

!BlockNode class methodsFor:'documentation'!

copyright
"
 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.
"
!

documentation
"
    node for parse-trees, representing blocks
    This is a helper class for the compiler.

    [author:]
        Claus Gittinger
"
! !

!BlockNode class methodsFor:'instance creation'!

arguments:argList home:homeBlock variables:vars
    |newBlock|

    newBlock := (self basicNew) setArguments:argList home:homeBlock variables:vars.
    homeBlock notNil ifTrue:[
        homeBlock rememberSubBlock:newBlock
    ].
    ^ newBlock

    "Modified: 28.6.1997 / 15:14:45 / cg"
! !

!BlockNode methodsFor:'accessing'!

accessedOuterBlockVars
    "return a collection of outer blockVars/args which are accessed
     in this block"

    ^ accessedOuterBlockVars ? #()

    "Modified: 18.6.1997 / 12:06:31 / cg"
    "Created: 2.7.1997 / 17:29:56 / cg"
!

arguments
    ^ blockArgs
!

arguments:argList
    blockArgs := argList
!

blockArgAccessed
    "return true if any block argument is accessed in the block"

    ^ blockArgAccessedInBlock ? false

    "Modified: 18.6.1997 / 12:06:31 / cg"
!

blockArgAccessed:aBoolen
    "set/clear the flag stating if any block argument is accessed in the block"

    blockArgAccessedInBlock := aBoolen

    "Created: 18.6.1997 / 11:35:00 / cg"
    "Modified: 18.6.1997 / 12:06:43 / cg"
!

endLineNumber
    ^ endLineNr

    "Created: 23.10.1996 / 15:51:32 / cg"
!

endLineNumber:aNumber
    endLineNr := aNumber

    "Created: 21.10.1996 / 14:17:57 / cg"
!

home
    ^ home
!

home:aBlock
    home := aBlock
!

indexOfFirstTemp:index
    indexOfFirstTemp := index

    "Created: 25.6.1997 / 17:24:27 / cg"
!

inlineBlock:aBoolean
    inlineBlock := aBoolean
!

isInlineBlock
    ^ inlineBlock

    "Created: 25.6.1997 / 14:11:33 / cg"
!

lineNumber
    ^ lineNr

    "Created: 23.10.1996 / 15:51:50 / cg"
!

lineNumber:aNumber
    lineNr := aNumber
!

needsHome
    ^ needsHome
!

needsHome:aBoolean
    needsHome := aBoolean
!

possiblyInlined:aBoolean
    possiblyInlined := aBoolean

    "Created: 2.7.1997 / 11:32:00 / cg"
!

statements
    ^ statements
!

statements:s
    statements := s
!

variables
    ^ blockVars
!

variables:varList
    blockVars := varList
! !

!BlockNode methodsFor:'block messages'!

doesNotUnderstand:aMessage
    |numArgs kludgeBlock|

    (Block implements:(aMessage selector)) ifTrue:[

	"/ mhmh - a message which I dont understand, but Block implements
	"/  send it to a kludgeblock, which will evaluate me again ..."

	numArgs := blockArgs size.
	numArgs == 0 ifTrue:[
	    kludgeBlock := [self value]
	] ifFalse:[
	    numArgs == 1 ifTrue:[
		kludgeBlock := [:a1 | self value:a1].
	    ] ifFalse:[
		numArgs == 2 ifTrue:[
		    kludgeBlock := [:a1 :a2 | self value:a1 value:a2].
		] ifFalse:[
		    numArgs == 3 ifTrue:[
			kludgeBlock := [:a1 :a2 :a3| self value:a1 value:a2 value:a3].
		    ] ifFalse:[
			numArgs == 4 ifTrue:[
			    kludgeBlock := [:a1 :a2 :a3 :a4| self value:a1 value:a2 value:a3 value:a4].
			] ifFalse:[
			    ^ self error:'only support blocks with up-to 4 args'
			]
		    ]
		]
	    ]
	].
	^ kludgeBlock perform:aMessage selector withArguments:aMessage arguments
    ].
    ^ super doesNotUnderstand:aMessage
! !

!BlockNode methodsFor:'code generation'!

checkForSimpleBlock
    "simple things can be made cheap blocks right now -
     resulting in a simple pushLit instruction ..."

    |cheapy e val code stackSize|

    statements isNil ifTrue:[
        "a []-block"

        val := nil
    ] ifFalse:[
        statements nextStatement notNil ifTrue:[^ nil].
        (statements isMemberOf:StatementNode) ifFalse:[^ nil].

        e := statements expression.
        e isConstant ifFalse:[^ nil].

        val := e value.
    ].

    stackSize := 0.

    val == 0 ifTrue:[
        "a [0]-block"

        code := ByteArray with:(ByteCodeCompiler byteCodeFor:#ret0).
    ].
    val == 1 ifTrue:[
        "a [1]-block"

        stackSize := 1.
        code := ByteArray with:(ByteCodeCompiler byteCodeFor:#push1)
                          with:(ByteCodeCompiler byteCodeFor:#retTop).
    ].

    val == true ifTrue:[
        "a [true]-block"

        code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retTrue).
    ].

    val == false ifTrue:[
        "a [false]-block"

        code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retFalse).
    ].

    val == nil ifTrue:[
        "a [nil]-block"

        code := ByteArray with:(ByteCodeCompiler byteCodeFor:#retNil).
    ].

    code notNil ifTrue:[
        cheapy := CheapBlock
                    byteCode:code
                    numArgs:(blockArgs size)
                    numStack:stackSize
                    sourcePosition:nil 
                    initialPC:nil 
                    literals:nil.
        ^ ConstantNode type:#Block value:cheapy
    ].

    ^ nil

    "Modified: 13.4.1997 / 00:05:29 / cg"
!

codeForSideEffectOn:aStream inBlock:b for:aCompiler
    "generate code for this statement - value not needed.
     For blocks, no code is generated at all."

    ^ self
!

codeInlineOn:aStream inBlock:b for:aCompiler
    self codeInlineOn:aStream inBlock:b valueNeeded:true for:aCompiler
!

codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
    |thisStatement nextStatement tmpIndex firstTempIndex codeBlock|

    blockVars notNil ifTrue:[
        "/ have to move blockvars into surrounding context

        "/ find the first non-inlined block
        codeBlock := b.
        [codeBlock notNil and:[codeBlock isInlineBlock]] whileTrue:[
            codeBlock := codeBlock home.
        ].

        blockVars do:[:aBlockVar |
            codeBlock isNil ifTrue:[
                "/ in method - add more temps to the method
                tmpIndex := aCompiler addTempVar.
            ] ifFalse:[
                "/ in another block - add more temps to the block
                tmpIndex := codeBlock addTempVar
            ].

            firstTempIndex isNil ifTrue:[
                firstTempIndex := tmpIndex.
                indexOfFirstTemp isNil ifTrue:[
                    indexOfFirstTemp := tmpIndex
                ].
            ].

            "/ block vars must be nilled 
            "/ (in case the previous block left some value there).
            "/ This nilling should be optimized away, if
            "/ the variable gets a value assigned before the first send.

            aStream nextPut:#pushNil.
            codeBlock isNil ifTrue:[
                "/ in method
                (tmpIndex <= 6) ifTrue:[
                    aStream nextPut:(#(storeMethodVar1 storeMethodVar2
                                       storeMethodVar3 storeMethodVar4
                                       storeMethodVar5 storeMethodVar6) at:tmpIndex).
                ] ifFalse:[
                    aStream nextPut:#storeMethodVar; nextPut:tmpIndex.
                ]
            ] ifFalse:[
                "/ in another block
                aStream nextPut:#storeBlockVar; nextPut:tmpIndex.
            ]
        ].
    ].

    inlineBlock := true.

    statements isNil ifTrue:[
        valueNeeded ifTrue:[
            aStream nextPut:#pushNil
        ]
    ] ifFalse:[
        thisStatement := statements.
        [thisStatement notNil] whileTrue:[
            nextStatement := thisStatement nextStatement.
            (nextStatement notNil or:[valueNeeded not]) ifTrue:[
                thisStatement codeForSideEffectOn:aStream inBlock:b for:aCompiler
            ] ifFalse:[
                thisStatement codeOn:aStream inBlock:b for:aCompiler
            ].
            thisStatement := nextStatement
        ]
    ].

"/    endLineNr notNil ifTrue:[
"/        ParseNode codeLineNumber:endLineNr on:aStream for:aCompiler
"/    ].

    "/ pop off temps (blockVars).
    "/ also, they are nilled to prevent any temp stuff
    "/ from NOT being garbage collected.
    "/ could optimize here, temps are reused soon.

    blockVars notNil ifTrue:[
        tmpIndex := firstTempIndex.
        codeBlock isNil ifTrue:[
            blockVars do:[:dummy |
                aStream nextPut:#pushNil.
                aStream nextPut:#storeMethodVar; nextPut:tmpIndex.
                aCompiler removeTempVar
            ]    
        ] ifFalse:[
            blockVars do:[:dummy | 
                aStream nextPut:#pushNil.
                aStream nextPut:#storeBlockVar; nextPut:tmpIndex.
                codeBlock removeTempVar
            ]    
        ].
        tmpIndex := tmpIndex + 1.
    ].

    "Modified: 26.6.1997 / 10:39:08 / cg"
!

codeOn:aStream inBlock:b for:aCompiler
    |thisStatement nextStatement lastStatement pos code cheapy p0|

    cheapy := self checkForSimpleBlock.
    cheapy notNil ifTrue:[
        cheapy codeOn:aStream inBlock:b for:aCompiler.
        ^ self
    ].

    pos := aStream position.

    aStream nextPut:#makeBlock.                                 "+0"
    aStream nextPut:0.                                          "+1"
    aStream nextPut:(blockVars size + maxNumTemp).              "+2"
    aStream nextPut:(blockArgs size).                           "+3"
                                                                "+4"
    p0 := pos+4.

    statements isNil ifTrue:[
        endLineNr notNil ifTrue:[
            ParseNode codeLineNumber:endLineNr on:aStream for:aCompiler
        ].
        aStream nextPut:#pushNil.          
        aStream nextPut:#retTop.
    ] ifFalse:[
        thisStatement := statements.
        [thisStatement notNil] whileTrue:[
            nextStatement := thisStatement nextStatement.
            nextStatement notNil ifTrue:[
                thisStatement codeForSideEffectOn:aStream inBlock:self for:aCompiler
            ] ifFalse:[
                lastStatement := thisStatement
            ].
            thisStatement := nextStatement
        ].

        lastStatement isPrimary ifTrue:[
            ReturnNode
                codeSimpleReturnFor:lastStatement expression 
                inBlock:nil 
                on:aStream 
                inLine:endLineNr 
                for:aCompiler
        ].
        lastStatement codeOn:aStream inBlock:self for:aCompiler.
        endLineNr notNil ifTrue:[
            ParseNode codeLineNumber:endLineNr on:aStream for:aCompiler
        ].
        aStream nextPut:#retTop.
    ].

    code := (aStream contents).


    "/ sigh - during coding, inlined subBlocks may have added more
    "/ tempVars; patch the nvar byte ...

    code at:pos+2 put:(blockVars size + maxNumTemp).

    "check for [0]-block;
     these are sometimes used as in ... ifAbsent:[0]
    "
    (code at:p0) == #lineno ifTrue:[
        p0 := p0 + 2
    ] ifFalse:[
        (code at:p0) == #lineno16 ifTrue:[
            p0 := p0 + 3
        ]
    ].

    (code at:p0) == #ret0 ifTrue:[
        aStream position:pos.
        code grow:pos.
        aStream nextPut:#mk0Block.
        ^ self
    ].    

    "check for [nil]-block;
     these come to play when code in blocks is commented
     out, or as dummy exception blocks
    "
    (code at:p0) == #retNil ifTrue:[
        aStream position:pos.
        code grow:pos.
        aStream nextPut:#mkNilBlock.
        ^ self
    ].    

    code at:pos+1 put:(aStream position)

    "Modified: 26.6.1997 / 10:48:56 / cg"
! !

!BlockNode methodsFor:'code generation helpers'!

addTempVar
    "add a temporary variable; return its position (1-based).
     Used when a block with args/locals is inlined."

    inlineBlock ifTrue:[self halt:'should not happen'].

    numTemp isNil ifTrue:[numTemp := maxNumTemp := 0].
    numTemp := numTemp + 1.
    maxNumTemp := maxNumTemp max:numTemp.
    ^ numTemp + self numVars

    "Modified: 26.6.1997 / 09:52:23 / cg"
!

removeTempVar
    "remove a temporary variable"

    numTemp := numTemp - 1.

    "Created: 25.6.1997 / 14:04:20 / cg"
    "Modified: 25.6.1997 / 15:07:07 / cg"
! !

!BlockNode methodsFor:'enumeration'!

allSubBlocksDo:aBlock
    "recursively enumerate all of my subblocks"

    subBlocks notNil ifTrue:[
        subBlocks do:[:aSubBlockNode |
            aBlock value:aSubBlockNode.
            aSubBlockNode allSubBlocksDo:aBlock.
        ]
    ]

    "Created: 2.7.1997 / 10:51:59 / cg"
!

nodeDo:anEnumerator
    "helper for parse tree walking"

    |args|

    args := blockArgs ? #().
    args := args collect:[:var |
        |p|

        p := ParameterNode new.
        p variable:var
    ].
    ^ anEnumerator doBlock:self arguments:args body:statements

    "Created: 19.6.1997 / 16:38:30 / cg"
    "Modified: 19.6.1997 / 17:17:57 / cg"
! !

!BlockNode methodsFor:'evaluating'!

evaluate
    ^ self
!

exitWith:something
    "return via return-statement"

    home notNil ifTrue:[
	home exitWith:something
    ].
    exitBlock value:something.
    ^ something
!

value
    (blockArgs size ~~ 0) ifTrue:[
	^ self wrongNumberOfArguments:0
    ].
    statements isNil ifTrue:[^ nil].
    exitBlock := [:val | ^ val].
    ^ statements evaluate
!

value:anArg
    |oldValue val|

    (blockArgs size ~~ 1) ifTrue:[
	^ self wrongNumberOfArguments:1
    ].
    statements isNil ifTrue:[^ nil].

    oldValue := (blockArgs at:1) value.
    (blockArgs at:1) value:anArg.

    exitBlock := [:v | 
	(blockArgs at:1) value:oldValue.
	^ v
    ].

    val := statements evaluate.

    (blockArgs at:1) value:oldValue.
    ^ val
!

value:arg1 value:arg2
    |oldValue1 oldValue2 val|

    (blockArgs size ~~ 2) ifTrue:[
	^ self wrongNumberOfArguments:2
    ].
    statements isNil ifTrue:[^ nil].

    oldValue1 := (blockArgs at:1) value.
    oldValue2 := (blockArgs at:2) value.
    (blockArgs at:1) value:arg1.
    (blockArgs at:2) value:arg2.

    exitBlock := [:v | 
	(blockArgs at:1) value:oldValue1.
	(blockArgs at:2) value:oldValue2.
	^ v
    ].

    val := statements evaluate.

    (blockArgs at:1) value:oldValue1.
    (blockArgs at:2) value:oldValue2.
    ^ val
!

value:arg1 value:arg2 value:arg3
    |oldValue1 oldValue2 oldValue3 val|

    (blockArgs size ~~ 3) ifTrue:[
	^ self wrongNumberOfArguments:3
    ].
    statements isNil ifTrue:[^ nil].

    oldValue1 := (blockArgs at:1) value.
    oldValue2 := (blockArgs at:2) value.
    oldValue3 := (blockArgs at:3) value.
    (blockArgs at:1) value:arg1.
    (blockArgs at:2) value:arg2.
    (blockArgs at:3) value:arg3.

    exitBlock := [:v | 
	(blockArgs at:1) value:oldValue1.
	(blockArgs at:2) value:oldValue2.
	(blockArgs at:3) value:oldValue3.
	^ v
    ].

    val := statements evaluate.

    (blockArgs at:1) value:oldValue1.
    (blockArgs at:2) value:oldValue2.
    (blockArgs at:3) value:oldValue3.
    ^ val
!

value:arg1 value:arg2 value:arg3 value:arg4
    |oldValue1 oldValue2 oldValue3 oldValue4 val|

    (blockArgs size ~~ 4) ifTrue:[
	^ self wrongNumberOfArguments:4
    ].
    statements isNil ifTrue:[^ nil].

    oldValue1 := (blockArgs at:1) value.
    oldValue2 := (blockArgs at:2) value.
    oldValue3 := (blockArgs at:3) value.
    oldValue4 := (blockArgs at:4) value.
    (blockArgs at:1) value:arg1.
    (blockArgs at:2) value:arg2.
    (blockArgs at:3) value:arg3.
    (blockArgs at:4) value:arg4.

    exitBlock := [:v | 
	(blockArgs at:1) value:oldValue1.
	(blockArgs at:2) value:oldValue2.
	(blockArgs at:3) value:oldValue3.
	(blockArgs at:4) value:oldValue4.
	^ v
    ].

    val := statements evaluate.

    (blockArgs at:1) value:oldValue1.
    (blockArgs at:2) value:oldValue2.
    (blockArgs at:3) value:oldValue3.
    (blockArgs at:4) value:oldValue4.
    ^ val
!

valueWithArguments:argArray
    |oldValues val|

    (blockArgs size ~~ argArray size) ifTrue:[
	^ self wrongNumberOfArguments:argArray size
    ].
    statements isNil ifTrue:[^ nil].

    oldValues := Array new:(argArray size).
    1 to:argArray size do:[:i |
	oldValues at:i put:(blockArgs at:i) value.
	(blockArgs at:i) value:(argArray at:i).
    ].
    exitBlock := [:v | 
	1 to:argArray size do:[:i |
	   ( blockArgs at:i) value:(oldValues at:i)
	].
	^ v
    ].

    val := statements evaluate.

    1 to:argArray size do:[:i |
	(blockArgs at:i) value:(oldValues at:i)
    ].
    ^ val
!

wrongNumberOfArguments:numberGiven
    Block argumentSignal
	raiseRequestWith:self
	errorString:('block got ' , numberGiven printString ,
		     ' args while ' , blockArgs size printString , ' where expected')
! !

!BlockNode methodsFor:'looping'!

whileFalse:aBlock
    self value ifTrue:[^ nil].
    aBlock value.
    thisContext restart
!

whileTrue:aBlock
    self value ifFalse:[^ nil].
    aBlock value.
    thisContext restart
! !

!BlockNode methodsFor:'misc'!

rememberOuterBlockVarAccess:aVariableNode
    accessedOuterBlockVars isNil ifTrue:[
        accessedOuterBlockVars := OrderedCollection new.
    ].
    accessedOuterBlockVars add:aVariableNode

    "Modified: 2.7.1997 / 18:52:49 / cg"
!

rememberSubBlock:aBlockNode
    subBlocks isNil ifTrue:[
        subBlocks := OrderedCollection new.
    ].
    subBlocks add:aBlockNode

    "Created: 28.6.1997 / 15:13:20 / cg"
    "Modified: 2.7.1997 / 11:11:26 / cg"
! !

!BlockNode methodsFor:'printing'!

printOn:aStream indent:i
    |n "{Class: SmallInteger }"|

    aStream nextPut:$[.
    (n := blockArgs size) > 0 ifTrue:[
	1 to:n do:[:index |
	    aStream nextPut:$:.
	    aStream nextPutAll:(blockArgs at:index) name.
	    aStream space.
	].
	aStream nextPut:$|.
	aStream space.
    ].
    (n := blockVars size) > 0 ifTrue:[
	aStream nextPut:$|.
	1 to:n  do:[:index |
	    aStream nextPutAll:(blockVars at:index) name.
	    aStream space.
	].
	aStream nextPut:$|.
    ].
    statements notNil ifTrue:[
	aStream cr.
	statements printAllOn:aStream indent:i + 4.
	aStream cr. 
	aStream spaces:i.
    ].
    aStream nextPut:$]
! !

!BlockNode methodsFor:'private accessing'!

setArguments:argList home:h variables:vars
    inlineBlock := false.
    needsHome := false.
    blockArgs := argList.
    home := h.
    blockVars := vars.
    numTemp := maxNumTemp := 0.

    "Modified: 25.6.1997 / 15:07:52 / cg"
! !

!BlockNode methodsFor:'queries'!

collectBlocksInto:aCollection
     aCollection add:self.
     statements notNil ifTrue:[statements collectBlocksInto:aCollection]

    "Created: 23.10.1996 / 15:45:16 / cg"
    "Modified: 23.10.1996 / 16:02:57 / cg"
!

endsWithReturn
    statements isNil ifTrue:[
        ^ false
    ].
    ^ statements listEndsWithReturn

    "Created: 19.8.1996 / 14:36:32 / cg"
!

indexOfFirstTemp
    ^ indexOfFirstTemp

    "Created: 25.6.1997 / 15:39:11 / cg"
!

isBlock
    "a kludge, to have blocknodes mimic blocks"

    ^ true
!

isInlinable
    "return true, if the receiver is inlinable.
     For now, do NOT inline a block, if it has args/vars
     which are accessed by subblocks, which are themself
     not inlinable.
     This limitation is needed for the following piece of code to work:
        1 to:10 do:[:i |
            .... [ something with i ]
        ]
     If this block was inlined, each subblock would get the same i
     (which is the old ST/V behavior)"

    possiblyInlined == true ifFalse:[
        ^ false
    ].

    (self numArgs ~~ 0 or:[self numVars ~~ 0]) ifTrue:[
        "/ any subblock, which accesses a var/arg of myself ?
        self allSubBlocksDo:[:aSubBlockNode | 
            aSubBlockNode accessedOuterBlockVars do:[:aVarNode |
                |b|

                aVarNode block == self ifTrue:[
                    "/ all-inbetween inlinable ?
                    b := aSubBlockNode.
                    [b ~~ self] whileTrue:[
                        b isInlinable ifFalse:[
"/ 'not inlined due to access: ' print. aVarNode displayString printCR.
                            ^ false
                        ].
                        b := b home
                    ]
                ]
            ]
        ]
    ].

    ^ true

    "Created: 2.7.1997 / 10:43:37 / cg"
    "Modified: 2.7.1997 / 18:55:36 / cg"
!

numArgs
    "return the number of arguments the block represented by myself
     expects for evaluation"

    ^ blockArgs size

    "Created: 23.10.1996 / 15:57:04 / cg"
    "Modified: 7.5.1997 / 15:34:35 / cg"
!

numVars
    ^ blockVars size

    "Created: 23.10.1996 / 16:17:07 / cg"
!

simpleSendBlockExpression
    blockVars notNil ifTrue:[^ nil].
    statements isNil ifTrue:[^ nil].
    statements nextStatement notNil ifTrue:[^ nil].
    ^ statements expression

    "Created: 13.12.1995 / 20:06:09 / cg"
! !

!BlockNode class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.48 1997-07-02 16:55:54 cg Exp $'
! !