"

 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 invokationSelector'

	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

!

invokationSelector

    "return the value of the instance variable 'invokationSelector' (automatically generated)"

    ^ invokationSelector

    "Created: / 2.4.1998 / 15:00:06 / cg"

!

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"

!

possiblyInlined:aBoolean withSelector:selector

    possiblyInlined := aBoolean.

    invokationSelector := selector.

    "Created: / 2.4.1998 / 19:07:53 / 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 isConstRet singleInsn code stackSize|

    isConstRet := false.

    statements isNil ifTrue:[

        "a []-block"

        val := nil.

        isConstRet := true.

    ] ifFalse:[

        statements nextStatement notNil ifTrue:[^ nil].

        (statements isMemberOf:StatementNode) ifFalse:[^ nil].

        e := statements expression.

        e isConstant ifTrue:[

            val := e value.

            isConstRet := true.

        ]

    ].

    isConstRet ifTrue:[

        stackSize := 0.

        val == 0 ifTrue:[

            "a [0]-block"

            singleInsn := #ret0.

        ] ifFalse:[ 

            val == 1 ifTrue:[

                "a [1]-block"

                stackSize := 1.

                code := ByteArray with:(ByteCodeCompiler byteCodeFor:#push1)

                                  with:(ByteCodeCompiler byteCodeFor:#retTop).

            ] ifFalse:[

                val == true ifTrue:[

                    "a [true]-block"

                    singleInsn := #retTrue

                ] ifFalse:[

                    val == false ifTrue:[

                        "a [false]-block"

                        singleInsn := #retFalse

                    ] ifFalse:[

                        val == nil ifTrue:[

                            "a [nil]-block"

                            singleInsn := #retNil

                        ]

                    ]

                ]

            ]

        ].

        singleInsn notNil ifTrue:[

            code := ByteArray with:(ByteCodeCompiler byteCodeFor:singleInsn).

        ].

    ].

    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 subAccess|

    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:[

        "/ if any subblock refers to locals or args,

        "/ do not nil out ...

        subAccess := false.

        self allSubBlocksDo:[:aSubBlockNode | 

            aSubBlockNode accessedOuterBlockVars do:[:aVarNode |

                |b|

                aVarNode block == self ifTrue:[

                    subAccess := true

                ]

            ]

        ].

        subAccess ifFalse:[

            tmpIndex := firstTempIndex.

            blockVars do:[:dummy |

                aStream nextPut:#pushNil.

                codeBlock isNil ifTrue:[

                    aStream nextPut:#storeMethodVar; nextPut:tmpIndex.

                    aCompiler removeTempVar.

                ] ifFalse:[

                    aStream nextPut:#storeBlockVar; nextPut:tmpIndex.

                    codeBlock removeTempVar.

                ].

                tmpIndex := tmpIndex + 1.

            ].    

        ].    

    ].

    "Modified: 30.7.1997 / 12:21:07 / 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:[

            self 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:[

            self 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]