"{ Encoding: utf8 }"

"

 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' }"

"{ NameSpace: Smalltalk }"

ParseNode subclass:#BlockNode

	instanceVariableNames:'blockArgs statements home inlineBlock exitBlock blockVars

		needsHome lineNr endLineNr blockArgAccessedInBlock numTemp

		maxNumTemp indexOfFirstTemp subBlocks accessedOuterBlockVars

		possiblyInlined invocationSelector charStartIndex charEndIndex

		index inlined endPointIndex modifiedBlockVars'

	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 

    |newBlock|

    newBlock := (self basicNew) setArguments:argList home:homeBlock.

    homeBlock notNil ifTrue:[

        homeBlock rememberSubBlock:newBlock

    ].

    ^ newBlock

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

!

arguments:argList home:homeBlock variables:vars

    |newBlock|

    newBlock := self arguments:argList home:homeBlock.

    newBlock variables:vars.

    ^ newBlock

!

home:homeBlock 

    |newBlock|

    newBlock := (self basicNew) setHome:homeBlock.

    homeBlock notNil ifTrue:[

        homeBlock rememberSubBlock:newBlock

    ].

    ^ newBlock

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

!

withExpression:exprNode in:home

    "a utility function for code generators"

    ^ (self arguments:#() home:home variables:#())

        statements:(StatementNode new expression:exprNode)

    "Created: / 25-10-2011 / 17:44:05 / 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"

!

charEndIndex

    ^ charEndIndex

!

charEndIndex:something

    charEndIndex := something.

!

charStartIndex

    ^ charStartIndex

!

charStartIndex:something

    charStartIndex := something.

!

endLineNumber

    ^ endLineNr

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

!

endLineNumber:aNumber

    endLineNr := aNumber

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

!

endPointIndex

    ^ endPointIndex

!

endPointIndex:something

    endPointIndex := something.

!

firstStatement

    statements isNil ifTrue:[^ nil].

    ^ statements "sigh - its a linked list"

!

home

    ^ home

!

home:aBlock

    home := aBlock

!

indexOfFirstTemp:index

    indexOfFirstTemp := index

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

!

inlineBlock:aBoolean

    inlineBlock := aBoolean

!

invocationSelector

    "the selector, by which this block is invoked"

    ^ invocationSelector

    "Created: / 27-04-2010 / 11:56:22 / cg"

!

invokationSelector

    <resource: #obsolete>

    ^ invocationSelector

    "Created: / 02-04-1998 / 15:00:06 / cg"

    "Modified: / 27-04-2010 / 11:56:44 / cg"

!

isInlineBlock

    ^ (inlineBlock == true)

    "Created: / 25-06-1997 / 14:11:33 / cg"

!

lastStatement

    statements isNil ifTrue:[^ nil].

    ^ statements last "sigh - its a linked list"

!

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.

    invocationSelector := selector.

    "Created: / 02-04-1998 / 19:07:53 / cg"

    "Modified: / 27-04-2010 / 11:56:51 / cg"

!

statements

    ^ statements

!

statements:s

    statements notNil ifTrue:[statements parent: nil].

    statements := s.

    statements notNil ifTrue:[statements parent: self].

    "Modified: / 20-07-2011 / 19:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

variables

    ^ blockVars

!

variables:varList

    blockVars := varList

!

variablesIncludingInlined: forStcCompiledCode

    "Returns all my local variables including those of block inlined into

     the receiver. If `forStcCompiledCode` is true then assume

     the code is compiled by stc, otherwise assume the code is

     compiled by bytecode compiler"

    | myBlocks |

    myBlocks := OrderedCollection new.

    self collectBlocksInto: myBlocks.

    myBlocks := myBlocks select:[:block | block isInlinedInto: self assumeStcCompiled: forStcCompiledCode. ].

    ^ myBlocks notEmpty ifTrue:[

        OrderedCollection streamContents:[:s|

            s nextPutAll: blockVars ? #().

            myBlocks do:[:block | s nextPutAll: block variables ? #() ].

        ]

    ] ifFalse:[

        blockVars

    ].

    "Created: / 19-08-2013 / 11:37:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BlockNode methodsFor:'block messages'!

doesNotUnderstand:aMessage

    |numArgs kludgeBlock|

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

        "/ mhmh - a message which I don't 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'

                        ]

                    ]

                ]

            ]

        ].

        ^ aMessage sendTo:kludgeBlock.

    ].

    ^ 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

    "

    <ignore: RBReturnsBooleanAndOtherRule rationale: 'done by purpose' author: 'cg'>

    |cheapy val isConstRet singleInsn code stackSize|

    isConstRet := false.

    statements isNil ifTrue:[

        self argumentCount == 0 ifTrue:[

            "a []-block"

            aStream nextPut:#mkNilBlock.

            ^ true.

        ].

        val := nil.

        isConstRet := true.

    ] ifFalse:[

        statements isConstant ifTrue:[

            val := statements expression value.

            self argumentCount == 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: / 16-07-2017 / 13:30:41 / cg"

!

codeForSideEffectOn:aStream inBlock:b for:aCompiler

    "generate code for this statement - value not needed.

     For blocks, no code is generated at all."

    aCompiler 

        warning:(statements isNil 

                    ifTrue:[ 'useless empty block.' ]

                    ifFalse:[ 'useless block - the statement(s) inside will not be evaluated.' ])

        position:startPosition to:endPosition.

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

            ]

        ].