"

 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

	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:h variables:vars

    ^ (self basicNew) setArguments:argList home:h variables:vars

! !

!BlockNode methodsFor:'accessing'!

arguments

    ^ blockArgs

!

arguments:argList

    blockArgs := argList

!

home

    ^ home

!

home:aBlock

    home := aBlock

!

inlineBlock

    ^ inlineBlock

!

inlineBlock:aBoolean

    inlineBlock := aBoolean

!

lineNumber:aNumber

    lineNr := aNumber

!

needsHome

    ^ needsHome

!

needsHome:aBoolean

    needsHome := aBoolean

!

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|

    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.

    ].

    val == 0 ifTrue:[

        "a [0]-block"

        code := ByteArray with:(ByteCodeCompiler byteCodeFor:#ret0).

    ].

    val == 1 ifTrue:[

        "a [1]-block"

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

                    byteCode:code

                    numArgs:(blockArgs size)

                    sourcePosition:nil 

                    initialPC:nil 

                    literals:nil.

        ^ ConstantNode type:#Block value:cheapy

    ].

    ^ nil

!

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|

    blockVars notNil ifTrue:[

"/        Transcript showCR:'cannot (yet) compile block with blockvars inline'.

    ].

    inlineBlock := true.

    statements isNil ifTrue:[

    ] ifFalse:[

!

codeOn:aStream inBlock:b for:aCompiler

    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).      "+2"

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

    statements isNil ifTrue:[

    ] ifFalse:[

        thisStatement := statements.

        [thisStatement notNil] whileTrue:[

            nextStatement := thisStatement nextStatement.

            nextStatement notNil ifTrue:[

                thisStatement codeForSideEffectOn:aStream inBlock:self for:aCompiler

            ] ifFalse:[

            ].

            thisStatement := nextStatement

    ].

    "check for [0]-block;

     these are sometimes used as in ... ifAbsent:[0]

    "

    code := (aStream contents).

        ]

    ].

        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

    "

        aStream position:pos.

        code grow:pos.

        aStream nextPut:#mkNilBlock.

        ^ self

    ].    

! !

!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