"

 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.

"

"{ Package: 'stx:libcomp' }"

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

!

lineNumberOfFirstMessage

    ^ statements lineNumberOfFirstMessage

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

!

needsHome

    ^ needsHome

!

needsHome:aBoolean

    needsHome := aBoolean

!

nestingLevel    

    ^ home isNil ifTrue:[ 0 ] ifFalse:[ home nestingLevel + 1]

    "Created: / 15-01-2008 / 11:54:57 / cg"

!

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 includesSelector:(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'!

checkForSimpleBlockCodeOn:aStream for:aCompiler

    "simple things can be made cheap blocks right now -

     resulting in a simple pushLit instruction ...

     Return:

        true         -- bytecodes are on aStream

        aParseNode   -- Parsenode creating the cheap block

        nil          -- cheap block not possible

    "

    |cheapy val isConstRet singleInsn code stackSize|

    isConstRet := false.

    statements isNil ifTrue:[

        self numArgs == 0 ifTrue:[

            "a []-block"

            aStream nextPut:#mkNilBlock.

            ^ true.

        ].

        val := nil.

        isConstRet := true.

    ] ifFalse:[statements isConstant ifTrue:[

        val := statements expression value.

        self numArgs == 0 ifTrue:[

            val == 0 ifTrue:[

                aStream nextPut:#mk0Block.

                ^ true.

            ].

            val isNil ifTrue:[

                aStream nextPut:#mkNilBlock.

                ^ true.

            ].

        ].    

        isConstRet := true.

    ]].

    isConstRet ifTrue:[

        stackSize := 0.

        (val isInteger and:[val between:-128 and:127]) ifTrue:[

            "a [-128..127]-block"

            val < 0 ifTrue:[val := val + 256].

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

                              with:val.

        ] ifFalse:[val == true ifTrue:[

            "a [true]-block"

            singleInsn := #retTrue

        ] ifFalse:[val == false ifTrue:[

            "a [false]-block"

            singleInsn := #retFalse

        ] ifFalse:[val isNil 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)

                    numVars:0

                    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|

    cheapy := self checkForSimpleBlockCodeOn:aStream for:aCompiler.

    cheapy notNil ifTrue:[

        "if result == true - code is already on aStream"

        cheapy ~~ true ifTrue:[

            cheapy codeOn:aStream inBlock:b for:aCompiler.

        ].

        ^ self

    ].

    "cheap block detection filters out blocks with no statements"

    pos := aStream position1Based.

    aStream nextPut:#makeBlock.                                 "+0"

    aStream nextPut:0.                                          "+1"

    aStream nextPut:(blockVars size + (maxNumTemp?0)).          "+2"

    aStream nextPut:(blockArgs size).                           "+3"

                                                                "+4"

    thisStatement := statements.

    [thisStatement notNil] whileTrue:[

        nextStatement := thisStatement nextStatement.

        nextStatement notNil ifTrue:[

            thisStatement codeForSideEffectOn:aStream inBlock:self for:aCompiler

        ] ifFalse:[

            lastStatement := thisStatement

        ].

        thisStatement := nextStatement

    ].

    lastStatement 

            codeForSimpleReturnOn:aStream

            inBlock:self 

            lineNumber:endLineNr 

            for:aCompiler.

    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?0)).

    "set the end of the block's code"

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

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