"

 COPYRIGHT (c) 1994 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.

"

ExecutableFunction variableSubclass:#CompiledCode

	instanceVariableNames:'flags byteCode'

	classVariableNames:'NoByteCodeSignal InvalidByteCodeSignal InvalidInstructionSignal

		BadLiteralsSignal NonBooleanReceiverSignal ArgumentSignal'

	poolDictionaries:''

	category:'Kernel-Methods'

!

!CompiledCode class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1994 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

"

    This is an abstract class, to merge common attributes of Blocks and

    Methods i.e. describe all objects consisting of either compiled or 

    interpreted code.

    Instances of CompiledCode are not to be created by user code

    (the compilers create Blocks, Methods etc.)

    [Instance variables:]

      flags       <SmallInteger>    special flag bits coded in a number

      byteCode    <ByteArray>       bytecode if its an interpreted codeobject

      The block/methods literals are stored in the indexed instance variables.

      If there is only one indexed instvar, it contains a reference to an

      Object containing the literals.

    [Class variables:]

      NoByteCodeSignal              raised if a codeObject is about to be executed

                                    which has neither code nor byteCode (i.e. both are nil)

      InvalidByteCodeSignal         raised if byteCode is not an instance of ByteArray

      InvalidInstructionSignal      raised if an invalid instruction opcode is encountered

      BadLiteralsSignal             raised if literalArray is not an array

      NonBooleanReceiverSignal      raised for conditional jumps where receiver is not a boolean

      ArgumentSignal                raised if argument count is not what the codeObject expects

    all of these signals are children of ExecutionErrorSignal.

    NOTICE: layout known by runtime system and compiler - do not change

    [author:]

        Claus Gittinger

"

! !

!CompiledCode class methodsFor:'initialization'!

initialize

    "create signals raised by various errors"

    NoByteCodeSignal isNil ifTrue:[

        NoByteCodeSignal := ExecutionErrorSignal newSignalMayProceed:true.

        NoByteCodeSignal nameClass:self message:#noByteCodeSignal.

        NoByteCodeSignal notifierString:'nil byteCode in code-object - not executable'.

        InvalidByteCodeSignal := ExecutionErrorSignal newSignalMayProceed:true.

        InvalidByteCodeSignal nameClass:self message:#invalidByteCodeSignal.

        InvalidByteCodeSignal notifierString:'invalid byteCode in code-object - not executable'.

        InvalidInstructionSignal := ExecutionErrorSignal newSignalMayProceed:true.

        InvalidInstructionSignal nameClass:self message:#invalidInstructionSignal.

        InvalidInstructionSignal notifierString:'invalid instruction in code-object - not executable'.

        BadLiteralsSignal := ExecutionErrorSignal newSignalMayProceed:true.

        BadLiteralsSignal nameClass:self message:#badLiteralsSignal.

        BadLiteralsSignal notifierString:'bad literal table in code-object - should not happen'.

        NonBooleanReceiverSignal := ExecutionErrorSignal newSignalMayProceed:true.

        NonBooleanReceiverSignal nameClass:self message:#nonBooleanReceiverSignal.

        NonBooleanReceiverSignal notifierString:'if/while on non-boolean receiver'.

        ArgumentSignal := ExecutionErrorSignal newSignalMayProceed:true.

        ArgumentSignal nameClass:self message:#argumentSignal.

        ArgumentSignal notifierString:'bad argument(s)'.

    ]

    "Modified: 22.4.1996 / 16:33:38 / cg"

! !

!CompiledCode class methodsFor:'instance creation'!

new

    "create a new method with an indirect literal array

     stored in the first and only indexed instvar"

    ^ self basicNew:1.

    "Created: / 24.6.1996 / 17:21:46 / stefan"

    "Modified: / 23.1.1998 / 16:31:28 / stefan"

!

new:numberOfLiterals

    "create a new method with numberOfLiterals.

     Implementation note:

        If (self size) == 1, the only literal is an indirect literal

        containing an array of literals. Otherwise the literals

        are stored in self.

    "

    |nlits|

    nlits := numberOfLiterals.

    nlits <= 1 ifTrue:[

        nlits := nlits + 1.

    ].

    ^ self basicNew:nlits.

    "Created: 24.6.1996 / 17:20:13 / stefan"

    "Modified: 25.6.1996 / 14:25:14 / stefan"

! !

!CompiledCode class methodsFor:'Signal constants'!

argumentSignal

    "return the signal raised when something's wrong with the

     arguments"

    ^ ArgumentSignal

!

executionErrorSignal

    "return the parent-signal of all execution errors"

    ^ ExecutionErrorSignal

! !

!CompiledCode class methodsFor:'queries'!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned for myself, false for subclasses."

    ^ self == CompiledCode

    "Modified: 23.4.1996 / 15:57:03 / cg"

!

maxNumberOfArguments

    "return the maximum number of arguments a method can have.

     This is a limit in the VM, which may be removed in one of 

     the next versions ..."

%{  /* NOCONTEXT */

    RETURN (__MKSMALLINT(MAX_METHOD_ARGS));

%}

! !

!CompiledCode methodsFor:'Compatibility - ST-80'!

getSource

    "return the code objects source code, nil if none is available"

    ^ self source.

    "Created: 19.6.1997 / 16:32:15 / cg"

!

getSourceForUserIfNone:aBlock

    "return the code objects source code.

     If none is available, return the result from evaluating aBlock."

    |src| 

    Screen current shiftDown ifTrue:[^ aBlock value].

    src := self source.

    src isNil ifTrue:[^ aBlock value].

    ^ src withoutTrailingSeparators

    "Modified: 19.6.1997 / 16:31:53 / cg"

!

withAllBlockMethodsDo:aBlock

    aBlock value:self

    "Created: 18.4.1997 / 20:42:07 / cg"

! !

!CompiledCode methodsFor:'accessing'!

allLiterals

    "return a collection of all literals (includes all block literals)"

    ^ self literals ? #()

    "Modified: 19.6.1997 / 17:37:52 / cg"

!

allSymbolLiterals

    "return a collection of all symbol-literals"

    ^ self allLiterals select:[:lit | lit isSymbol]

    "Modified: / 19.6.1997 / 17:37:52 / cg"

    "Created: / 1.11.1997 / 13:14:44 / cg"

!

byteCode

    "return the bytecode (a ByteArray)"

    ^ byteCode

!

changeLiteral:aLiteral to:newLiteral

    "change aLiteral to newLiteral"

    |lits nLits "{ Class: SmallInteger }" |

    self size == 1 ifTrue:[

        lits := self at:1.

    ] ifFalse:[

        lits := self.

    ].

    nLits := lits size.

    1 to:nLits do:[:i|

        (lits at:i) == aLiteral ifTrue:[

            lits at:i put:newLiteral.

            ^ true.

        ].

    ].

    ^ false.

    "Created: 24.6.1996 / 15:08:11 / stefan"

    "Modified: 24.6.1996 / 17:07:56 / stefan"

    "Modified: 4.7.1996 / 11:12:39 / cg"

!

decompiledSource

    "reconstruct some synthetic source by decompiling by byteCode"

    |s|

    s := '' writeStream.

    self decompileTo:s.

    ^ s contents

    "Modified: / 30.1.1999 / 14:53:30 / cg"

    "Created: / 30.1.1999 / 14:54:09 / cg"

!

decompiler

    ^ Decompiler

    "Created: 30.7.1997 / 16:36:40 / cg"

!

do:aBlock

    "same as #literalsDo:, in order to get common protocol with Array"

    ^ self literalsDo:aBlock

    "Modified: 25.6.1996 / 22:16:44 / stefan"

!

flags

    "return the flags (number of method variables, stacksize etc.).

     Dont depend on the values in the flag field - its interpretations

     may change without notice."

    ^ flags

    "Modified: / 30.1.1999 / 14:51:59 / cg"

!

literals

    "return the literal array"

    |lits numLits "{ Class: SmallInteger }"|

    numLits := self size.

    numLits == 0 ifTrue:[

        ^ #()

    ].

    numLits == 1 ifTrue:[

        ^ self at:1.    

    ].

    "there may be a dummy (nil) literal to make the size > 1"

    (self at:2) isNil ifTrue:[

        numLits := 1.

    ].

    lits := Array new:numLits.

    1 to:numLits do:[:i|

        lits at:i put:(self at:i).

    ].

    ^ lits.

    "

     (CompiledCode compiledMethodAt:#literals) literals

    "

    "Modified: / 30.1.1997 / 17:09:06 / cg"

    "Modified: / 23.1.1998 / 16:30:07 / stefan"

!

literalsDetect:aBlock ifNone:exceptionBlock

    "execute a one arg block for each of our literals.

     return the first literal for which aBlock returns true"

    |lits theLit numLits "{Class: SmallInteger }"|

    numLits := self size.

    numLits > 0 ifTrue:[

        numLits == 1 ifTrue:[

            lits := self at:1.

            numLits := lits size.

        ] ifFalse:[

            lits := self.

            "there may be a dummy (nil) literal to make the size > 1"

            (self at:2) isNil ifTrue:[

                numLits := 1.

            ].

        ].

        1 to:numLits do:[:i |

            theLit := lits at:i.

            (aBlock value:theLit) ifTrue:[

                ^ theLit.

            ].

        ].

    ].

    ^ exceptionBlock value.

    "Created: / 24.6.1996 / 14:27:35 / stefan"

    "Modified: / 30.1.1997 / 16:24:04 / cg"

    "Modified: / 23.1.1998 / 17:08:37 / stefan"

!

literalsDo:aBlock

    "execute a one arg block for each of our literals"

    |lits numLits "{ Class: SmallInteger }" |

    numLits := self size.

    numLits == 0 ifTrue:[

        ^ self

    ].

    numLits == 1 ifTrue:[

        lits := self at:1.

        numLits := lits size.

    ] ifFalse:[

        lits := self.

        "there may be a dummy (nil) literal to make the size > 1"

        (self at:2) isNil ifTrue:[

            numLits := 1.

        ].

    ].

    1 to:numLits do:[:i |

        aBlock value:(lits at:i).

    ].

    "Created: / 24.6.1996 / 14:17:12 / stefan"

    "Modified: / 30.1.1997 / 17:08:05 / cg"

    "Modified: / 23.1.1998 / 16:39:17 / stefan"

!

mclass

    "return the class of the receivers home method.

     Thats the class of the method where the block was compiled."

    ^ self homeMethod mclass

    "Modified: 19.6.1997 / 16:24:58 / cg"

    "Created: 19.6.1997 / 16:27:34 / cg"

!

numberOfMethodArgs

    "return the number of arguments, the method expects.

     This method is left for backward compatibility - use #numArgs." 

    "/ self obsoleteMethodWarning:'use numArgs'.

    ^ self numArgs

    "Modified: / 30.1.1999 / 14:55:27 / cg"

    "Created: / 30.1.1999 / 14:55:47 / cg"

!

numberOfMethodVars

    "return the number of method local variables. 

     This method is left for backward compatibility - use #numVars." 

    "/ self obsoleteMethodWarning:'use numVars'.

    ^ self numVars

    "Modified: / 30.1.1999 / 14:55:42 / cg"

    "Created: / 30.1.1999 / 14:55:51 / cg"

!

refersToLiteral:aLiteral

    "return true if the receiver or recursively any array element in the

     receiver referes to aLiteral"

    self literalsDo: [ :el | 

        el == aLiteral ifTrue:[^true].

        el class == Array ifTrue:[

            (el refersToLiteral: aLiteral) ifTrue: [^true]

        ]

    ].

    ^ false

    "

     (CompiledCode compiledMethodAt:#refersToLiteral:) refersToLiteral:#foo  

     (CompiledCode compiledMethodAt:#refersToLiteral:) refersToLiteral:#class  

    "

    "Modified: / 3.3.1998 / 00:02:28 / stefan"

! !

!CompiledCode methodsFor:'converting'!

makeRealMethod

    "by default, we are a real method.

     Subclasses (e.g. LazyMethod) may redefine this"

    ^ self

    "Created: 7.6.1996 / 12:45:50 / stefan"

! !

!CompiledCode methodsFor:'debugging'!

breakPointInProcess:aProcess

    "arrange for a breakpoint-debugger to be opened when this method

     is invoked from withn aProcess."

    MessageTracer trapMethod:self inProcess:aProcess.

    "Modified: / 12.1.1998 / 18:22:39 / cg"

    "Created: / 30.1.1999 / 14:50:01 / cg"

!

clearBreakPoint

    "remove any break/trace-point on this method"

    MessageTracer unwrapMethod:self.

    "Modified: / 12.1.1998 / 18:22:14 / cg"

    "Created: / 30.1.1999 / 14:49:53 / cg"

!

isCounted

    "obsolete - replaced by isCountinMemoryUsage"

    ^ MessageTracer notNil

      and:[MessageTracer isCountingMemoryUsage:self]

    "Modified: / 27.7.1998 / 11:05:36 / cg"

    "Created: / 30.1.1999 / 14:48:57 / cg"

!

isCounting

    "return true, if invokations of this method are counted"

    ^ MessageTracer notNil

      and:[MessageTracer isCounting:self]

    "Modified: / 27.7.1998 / 11:06:00 / cg"

    "Created: / 30.1.1999 / 14:49:19 / cg"