"

 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:#MessageNode

	instanceVariableNames:'receiver selector argArray lineNr'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Compiler-Support'

!

!MessageNode 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 message sends

    This is a helper class for the compiler.

    [author:]

        Claus Gittinger

"

! !

!MessageNode class methodsFor:'instance creation'!

receiver:recNode selector:selectorString 

    ^ (self basicNew) receiver:recNode selector:selectorString args:nil lineno:0

!

receiver:recNode selector:selectorString arg1:argNode1 arg2:argNode2 fold:folding

    |result recVal argVal selector|

    "

     This is just a demonstration - of how complex constants can be folded.

     This was inspired by some discussion in c.l.s about enhancing the language - I prefer

     enhancing the compiler ....

     The following optimization will convert '#(...) with:#(...) collect:[...]' into an array constant,

     allowing constant arrays of complex objects.

     Notice: this method is normally disabled - its just a demo after all.

    "

    folding notNil ifTrue:[

	"/

	"/ do constant folding ...

	"/

	(recNode isConstant and:[argNode1 isConstant]) ifTrue:[

	    "check if we can do it ..."

	    selector := selectorString asSymbolIfInterned.

	    selector notNil ifTrue:[

		recVal := recNode evaluate.

		(recVal respondsTo:selector) ifTrue:[

		    "

		     we could do much more here - but then, we need a dependency from

		     the folded selectors method to the method we generate code for ...

		     limit optimizations to those that will never change

		     (or - if you change them - you will crash so bad ...)

		    "

		    argVal := argNode1 evaluate.

		    ((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[

			folding == #full ifTrue:[

			    (selector == #with:collect:) ifTrue:[

			        (argNode2 isMemberOf:BlockNode) ifTrue:[

				    SignalSet anySignal handle:[:ex |

				        ^ 'error in constant expression (' , ex errorString , ')'

				    ] do:[

				        result := recVal perform:selector with:argVal with:(argNode2 evaluate).

				    ].

				    ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result

				]

			    ]

			]

		    ]

		]

	    ]

	]

    ].

    ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode1 with:argNode2) lineno:0

!

receiver:recNode selector:selectorString arg:argNode

    ^ self receiver:recNode selector:selectorString arg:argNode fold:nil

!

receiver:recNode selector:selectorString arg:argNode fold:folding

    |result recVal argVal selector globalName canFold|

   "

     The constant folding code can usually not optimize much

     - this may change when some kind of constant/macro declaration is added to smalltalk.

    "

    folding notNil ifTrue:[

	selector := selectorString asSymbolIfInterned.

	selector notNil ifTrue:[

	    "/

	    "/ do constant folding ...

	    "/

	    canFold := false.

            (recNode isGlobal and:[argNode isConstant]) ifTrue:[

                globalName := recNode name.

                recVal := recNode evaluate.

                (globalName = 'SmallInteger') ifTrue:[

                    ( #( bitMaskFor: ) includes:selector)

                    ifTrue:[

                        canFold := true

                    ]

                ].

                (globalName = 'Float') ifTrue:[

                    ( #( pi unity zero ) includes:selector)

                    ifTrue:[

                        (recVal respondsTo:selector) ifTrue:[

                            canFold := true

                        ]

                    ]

                ]

            ].

	    (recNode isConstant and:[argNode isConstant]) ifTrue:[

	        "check if we can do it ..."

		recVal := recNode evaluate.

		"

		 we could do much more here - but then, we need a dependency from

		 the folded selectors method to the method we generate code for ...

		 limit optimizations to those that will never change

		 (or - if you change them - you will crash so bad ...)

		"

		argVal := argNode evaluate.

		(recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[

		    ( #( + - * / // \\ min: max: quo:) includes:selector) ifTrue:[

			(#( / // \\ ) includes:selector) ifTrue:[

			    argVal = 0 ifTrue:[

				^ 'division by zero in constant expression'

			    ].

			].

			canFold := true

		    ].

		    ( #( @ ) includes:selector) ifTrue:[

			canFold := (folding == #full)

		    ]

		].

		(recVal isMemberOf:String) ifTrue:[

		    (argVal isInteger and:[selector == #at:]) ifTrue:[

			canFold := (folding >= #level2) or:[folding == #full].

		    ].

		    ((argVal isMemberOf:String) and:[selector == #',']) ifTrue:[

			canFold := (folding >= #level2) or:[folding == #full].

		    ]

		].

	    ].

	    canFold ifTrue:[

		(recVal respondsTo:selector) ifTrue:[

		    SignalSet anySignal handle:[:ex |

		        ^ 'error in constant expression (' , ex errorString , ')'

		    ] do:[

		        result := recVal perform:selector with:argVal.

		    ].

		    ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result

		]

	    ]

	]

    ].

    ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0

!

receiver:recNode selector:selectorString args:anArray

    ^ self receiver:recNode selector:selectorString args:anArray fold:nil

!

receiver:recNode selector:selectorString args:argArray fold:folding

    |numArgs|

    folding notNil ifTrue:[

        numArgs := argArray size.

        (numArgs == 1) ifTrue:[

            ^ self receiver:recNode selector:selectorString arg:(argArray at:1) fold:folding 

        ].

        "uncomment the follwoing for a nice array initializer optimization ..."

        (numArgs == 2) ifTrue:[

            ^ self receiver:recNode selector:selectorString arg1:(argArray at:1) arg2:(argArray at:2) fold:folding 

        ].

        numArgs > Method maxNumberOfArguments ifTrue:[

            ^ 'too many arguments for current VM implementation'.

        ].

    ].

    ^ (self basicNew) receiver:recNode selector:selectorString args:argArray lineno:0

    "Modified: 3.9.1995 / 16:41:39 / claus"

    "Modified: 21.3.1996 / 16:07:34 / cg"

! !

!MessageNode methodsFor:'accessing'!

arg1

    ^ argArray at:1

!

args

    ^ argArray

!

lineNumber

     ^ lineNr

!

lineNumber:num

     lineNr := num

!

receiver

    ^ receiver

!

receiver:r selector:s args:a lineno:l

    receiver := r.

    selector := s asSymbol.

    argArray := a.

    lineNr := l

!

selector

    ^ selector

! !

!MessageNode methodsFor:'checks'!

plausibilityCheck

    |rec arg operand|

    "

     it once took me almost an hour, to find a '==' which

     should have been an '=' (you cannot compare floats with ==)

     (well, I looked at the '==' at least 50 times -

      - but didn't think about it ...).

     thats reason enough to add this check here.

     I will add more as heuristic knowledge increases ...

     (send me comments on common programming errors ...)

    "

    "

     check #== appled to Floats, Strings or Fractions

    "

    ((selector == #==) or:[selector == #~~]) ifTrue:[

	receiver isConstant ifTrue:[

	    rec := receiver evaluate.

	    ((rec isMemberOf:String) or:[

	     (rec isMemberOf:Float) or:[

	     (rec isMemberOf:Fraction)]]) ifTrue:[

		operand := rec

	    ].

	].

	(argArray at:1) isConstant ifTrue:[

	    arg := (argArray at:1) evaluate.

	    ((arg isMemberOf:String) or:[

	     (arg isMemberOf:Float) or:[

	     (arg isMemberOf:Fraction)]]) ifTrue:[

		operand := arg

	    ].

	].

	operand notNil ifTrue:[

	    (selector == #==) ifTrue:[

		^ 'identity compare is unsafe here'

	    ].

	    ^ 'identity compare will usually return true here'

	]

    ].

    "

     [...] ifTrue:...

     an error often occuring when you are a beginner ...

    "

    ((selector == #ifTrue:) or:[selector == #ifFalse:]) ifTrue:[

	receiver isBlock ifTrue:[

	    (Block canUnderstand:selector) ifFalse:[

		^ 'blocks usually do not respond to ' , selector , ' messages'

	    ].

	].

	(argArray at:1) isBlock ifFalse:[

	    ^ 'will fail at runtime, if argument to ' , selector , ' does not evaluate to a block'

	]

    ].

    ((selector == #ifTrue:ifFalse:) or:[selector == #ifFalse:ifTrue:]) ifTrue:[

	receiver isBlock ifTrue:[

	    (Block canUnderstand:selector) ifFalse:[

		^ 'blocks usually do not respond to ' , selector , ' messages'

	    ].

	].

	(argArray at:1) isBlock ifFalse:[

	    ^ 'will fail at runtime, if 1st. argument to ' , selector , ' does not evaluate to a block'

	].

	(argArray at:2) isBlock ifFalse:[

	    ^ 'will fail at runtime, if 2nd. argument to ' , selector , ' does not evaluate to a block'

	]

    ].

    "

     (...) whileTrue:[

    "

    ((selector == #whileTrue:) or:[selector == #whileFalse:]) ifTrue:[

	receiver isBlock ifFalse:[

	    "

	     only warn, if code was originally parenthized

	    "

	    receiver parenthized ifTrue:[

		^ 'will fail at runtime, if receiver of ' , selector , ' does not evaluate to a block'

	    ]

	].

	(argArray at:1) isBlock ifFalse:[

	    ^ 'will fail at runtime, if argument to ' , selector , ' does not evaluate to a block'

	].

    ].

    ^ nil

! !

!MessageNode methodsFor:'code generation'!

codeAndIfElseOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler

    "generate code for (x and:[y]) ifxxx:[ ... ] ifyyy:[ ... ]"

    |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|

    theByteCode := #falseJump.

    theReceiver := receiver receiver.

    optByteCode := self optimizedConditionFor:theReceiver

                                         with:theByteCode.

    optByteCode notNil ifTrue:[

        ((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[

            theArg := theReceiver arg1

        ].

        theReceiver := theReceiver receiver.

        theByteCode := optByteCode

    ].

    "/ code the left-of the and-part

    theReceiver codeOn:aStream inBlock:b for:aCompiler.

    theArg notNil ifTrue:[

        theArg codeOn:aStream inBlock:b for:aCompiler

    ].

    aStream nextPut:theByteCode.

    pos1 := aStream position.   "/ remember branch target of left-fail branch

    aStream nextPut:0.

    "/ code the right of the and-part

    theReceiver := receiver arg1.

    theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.

    (selector == #ifTrue:ifFalse:) ifTrue:[

        jmp := #falseJump

    ] ifFalse:[

        jmp := #trueJump

    ].

    aStream nextPut:jmp.

    pos2 := aStream position.   "/ remember branch target of right-fail branch 

    aStream nextPut:0.

    code := aStream contents.

    (selector == #ifFalse:ifTrue:) ifTrue:[

        code at:pos1 put:(aStream position)

    ].

    "/ code the if-block

    (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.

    aStream nextPut:#jump.

    pos3 := aStream position.

    aStream nextPut:0.

    here := aStream position.

    (selector == #ifTrue:ifFalse:) ifTrue:[

        code at:pos1 put:here

    ].

    code at:pos2 put:here.

    "/ code the else-block

    (argArray at: 2) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.

    code at:pos3 put:(aStream position)

    "Created: 6.9.1996 / 12:56:23 / cg"

!

codeAndIfOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler

    "generate code for (x and:[y]) ifxxx:[ ... ]"

    |theByteCode optByteCode theReceiver theArg pos1 pos2 pos3 code here jmp|

    theByteCode := #falseJump.

    theReceiver := receiver receiver.

    optByteCode := self optimizedConditionFor:theReceiver

					 with:theByteCode.

    optByteCode notNil ifTrue:[

	((optByteCode == #eqJump) or:[optByteCode == #notEqJump]) ifTrue:[

	    theArg := theReceiver arg1

	].

	theReceiver := theReceiver receiver.

	theByteCode := optByteCode

    ].

    theReceiver codeOn:aStream inBlock:b for:aCompiler.

    theArg notNil ifTrue:[

	theArg codeOn:aStream inBlock:b for:aCompiler

    ].

    aStream nextPut:theByteCode.

    pos1 := aStream position.

    aStream nextPut:0.

    theReceiver := receiver arg1.

    theReceiver codeInlineOn:aStream inBlock:b for:aCompiler.

    (selector == #ifTrue:) ifTrue:[

	jmp := #falseJump

    ] ifFalse:[

	jmp := #trueJump

    ].

    aStream nextPut:jmp.

    pos2 := aStream position.

    aStream nextPut:0.

    code := aStream contents.

    (selector == #ifFalse:) ifTrue:[

	code at:pos1 put:(aStream position)

    ].

    (argArray at: 1) codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.

    valueNeeded ifTrue:[

	aStream nextPut:#jump.

	pos3 := aStream position.

	aStream nextPut:0.

	here := aStream position.

	(selector == #ifTrue:) ifTrue:[

	    code at:pos1 put:here

	].

	code at:pos2 put:here.

	aStream nextPut:#pushNil.

	code at:pos3 put:(aStream position)

    ] ifFalse:[

	here := aStream position.

	(selector == #ifTrue:) ifTrue:[

	    code at:pos1 put:here

	].

	code at:pos2 put:here

    ]

!

codeAndOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler

    "generate code for (x and:[y])"

    |pos1 rightExpr|

    receiver codeOn:aStream inBlock:b for:aCompiler.

    valueNeeded ifTrue:[

        aStream nextPut:#dup.

    ].

    aStream nextPut:#falseJump.

    pos1 := aStream position.

    aStream nextPut:0.

    valueNeeded ifTrue:[

        aStream nextPut:#drop.

    ].

    rightExpr := argArray at:1.

    rightExpr codeInlineOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler.

    (aStream contents) at:pos1 put:(aStream position)

    "Created: 17.6.1996 / 15:46:42 / cg"

    "Modified: 17.6.1996 / 15:47:44 / cg"

!