"

 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'

!

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

"

! !

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"

! !

new

    "create a new method with an inirect literal array

     stored in the first and only indexed instvar"

    ^ self basicNew:1.

    "Created: 24.6.1996 / 17:21:46 / 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"

! !

argumentSignal

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

     arguments"

    ^ ArgumentSignal

!

executionErrorSignal

    "return the parent-signal of all execution errors"

    ^ ExecutionErrorSignal

! !

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"

! !

!CompiledCode methodsFor:'accessing'!

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"

!

do:aBlock

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

    ^ self literalsDo:aBlock

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

!

literals

    "return the literal array"

    self size == 1 ifTrue:[

        ^ self at:1.

    ] ifFalse:[

        |sz lits|

        lits := Array new:(sz := self size).

        1 to:sz do:[:i|

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

        ].

        ^ lits.

    ].

    "

     (CompiledCode compiledMethodAt:#literals) literals

    "

    "Modified: 24.6.1996 / 17:12:06 / 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|

    self size == 1 ifTrue:[

        lits := self at:1.

    ] ifFalse:[

        lits := self.

    ].

    1 to:(lits size) do:[:i|

        (aBlock value:(lits at:i)) ifTrue:[

            ^ lits at:i.

        ].

    ].

    ^ exceptionBlock value.

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

    "Modified: 24.6.1996 / 17:13:02 / stefan"

!

literalsDo:aBlock

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

    |lits|

    self size == 1 ifTrue:[

        lits := self at:1.

    ] ifFalse:[

        lits := self.

    ].

    1 to:(lits size) do:[:i|

        aBlock value:(lits at:i)

    ].

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

    "Modified: 24.6.1996 / 17:13: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:'error handling'!

badArgumentArray

    "this error is triggered, if a non array is passed to 

     #valueWithReceiver:.. type of methods"

    ^ ArgumentSignal

        raiseRequestWith:self

        errorString:'argumentArray must be an Array'

    "Modified: 12.7.1996 / 21:53:43 / cg"

!

badLiteralTable

    "this error is triggered, when a block/method is called with a bad literal

     array (i.e. non-array) - this can only happen, if the

     compiler is broken or someone played around with a blocks/methods

     literal table or the GC is broken and corrupted it."

    ^ BadLiteralsSignal raise.

    "Modified: 12.7.1996 / 21:53:19 / cg"

!

invalidByteCode

    "this error is triggered when the interpreter tries to execute a

     code object, where the byteCode is nonNil, but not a ByteArray.

     Can only happen when Compiler/runtime system is broken or

     someone played around with a blocks/methods code."

    ^ InvalidByteCodeSignal raise.

    "Modified: 12.7.1996 / 21:52:59 / cg"

!

invalidInstruction

    "this error is triggered when the bytecode-interpreter tries to

     execute an invalid bytecode instruction.

     Can only happen when Compiler/runtime system is broken or

     someone played around with a blocks/methods code."

    ^ InvalidInstructionSignal raise.

    "Modified: 12.7.1996 / 21:52:50 / cg"

!

noByteCode

    "this error is triggered when the interpreter tries to execute a

     code object, where both the code and byteCode instances are nil.

     This can happen if:

        - the Compiler/runtime system is broken, (should not happen)

        - someone played around with a block/method, (you should not do this)

        - compilation of a lazy method failed

          (i.e. the lazy method contains an error or

           it contains primitive code and there is no stc compiler available)

        - an unloaded object modules method is called for.

     Only the first case is to be considered serious 

     - it should not happen if the system is used correctly."

    ^ NoByteCodeSignal raise.

    "Modified: 12.7.1996 / 21:52:34 / cg"

!

receiverNotBoolean:anObject

    "this error is triggered when the bytecode-interpreter tries to

     execute ifTrue:/ifFalse or whileTrue: - type of expressions where the

     receiver is neither true nor false.

     Machine compiled code does not detect this, and may behave undeterministec."

    ^ NonBooleanReceiverSignal raise.

    "Modified: 12.7.1996 / 21:55:18 / cg"

!

tooManyArguments

    "this error is triggered, when a method/block tries to perform a send with

     more arguments than supported by the interpreter. 

     This can only happen, if the compiler has been changed without 

     updating the VM, since the compiler checks for allowed number of

     arguments."

    ^ ArgumentSignal

        raiseRequestWith:self

        errorString:'too many args in send'

    "Modified: 12.7.1996 / 21:54:22 / cg"

! !

!CompiledCode methodsFor:'private accessing'!

byteCode:aByteArray

    "set the bytecode field - DANGER ALERT"

    byteCode := aByteArray

!

checked:aBoolean

    "set/clear the flag bit stating that this method has already been checked

     by the just-in-time compiler. Setting the flag prevents it from

     trying any compilation.

     Not for public use - for VM debugging only."

%{  /* NOCONTEXT */

    int newFlags = __intVal(__INST(flags));

    /* made this a primitive to get define in stc.h */

    if (aBoolean == true)

        newFlags |= F_CHECKED;

    else

        newFlags &= ~F_CHECKED;

    __INST(flags) = __MKSMALLINT(newFlags);

%}

!

dynamic

    "return the flag stating that the machine code was created

     dynamically (from bytecode)."

%{  /* NOCONTEXT */

    /* made this a primitive to get define in stc.h */

    RETURN (( (INT)(__INST(flags)) & __MASKSMALLINT(F_DYNAMIC)) ? true : false);

%}

!

literals:aLiteralArray 

    "set the literal array for evaluation - DANGER ALERT"

    |i|

    aLiteralArray isNil ifTrue:[

        ^ self.

    ].

    self size == 1 ifTrue:[

        self at:1 put:aLiteralArray.

    ] ifFalse:[

        i := 1.

        aLiteralArray do:[:literal|

            self at:i put:literal.

            i := i + 1.

        ].

    ].

    "Modified: 25.6.1996 / 22:13:08 / stefan"

!

markFlag

    "return the mark bits value as a boolean"

%{  /* NOCONTEXT */

    /* made this a primitive to get define in stc.h */

    RETURN (( (INT)(__INST(flags)) & __MASKSMALLINT(F_MARKBIT)) ? true : false);

%}

!

markFlag:aBoolean

    "set/clear the mark flag bit.

     This bit is not used by the VM, but instead free to mark codeObjects

     for any (debugging/tracing) use. For example, the coverage test uses

     these to mark reached methods. (inspired by a note in c.l.s)"

%{  /* NOCONTEXT */

    int newFlags = __intVal(__INST(flags));

    /* made this a primitive to get define in stc.h */

    if (aBoolean == true)

	newFlags |= F_MARKBIT;

    else

	newFlags &= ~F_MARKBIT;

    __INST(flags) = __MKSMALLINT(newFlags);

%}

!

test

   ^ #(1 2 3)

    "Created: 24.6.1996 / 17:02:45 / stefan"

! !

!CompiledCode methodsFor:'queries'!

decompileTo:aStream

    Decompiler notNil ifTrue:[

        Autoload autoloadFailedSignal handle:[:ex |

            ex return

        ] do:[

            Decompiler autoload.

        ].

    ].

    (Decompiler isNil or:[Decompiler isLoaded not]) ifTrue:[

        ^ false

    ].

    Decompiler decompile:self to:aStream.

    ^ true