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

Object subclass:#ExecutableFunction
       instanceVariableNames:'code* flags'
       classVariableNames:'ExecutionErrorSignal InvalidCodeSignal'
       poolDictionaries:''
       category:'Kernel-Methods'
!

ExecutableFunction comment:'
COPYRIGHT (c) 1994 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.8 1995-02-15 10:21:51 claus Exp $
'!

!ExecutableFunction 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.
"
!

version
"
$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.8 1995-02-15 10:21:51 claus Exp $
"
!

documentation
"
    This is an abstract class, to merge common attributes of all kinds of
    executable code objects; i.e. non-ST functions, Blocks and Methods.

    Instance variables:

      code        <not_an_object>   the function pointer to the machine code.
				    Not accessable from smalltalk code.

      flags       <SmallInteger>    special flag bits coded in a number


    Class variables:

      ExecutionErrorSignal          parent of all execution errors
				    (not raised itself)

      InvalidCodeSignal             codeObject is not executable

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

!ExecutableFunction class methodsFor:'queries'!

isBuiltInClass
    "this class is known by the run-time-system"

    ^ true
! !

!ExecutableFunction class methodsFor:'initialization'!

initialize
    InvalidCodeSignal isNil ifTrue:[
	Object initialize.

	ExecutionErrorSignal := ErrorSignal newSignalMayProceed:true.
	ExecutionErrorSignal nameClass:self message:#executionErrorSignal.
	ExecutionErrorSignal notifierString:'execution error'.

	InvalidCodeSignal := ExecutionErrorSignal newSignalMayProceed:true.
	InvalidCodeSignal nameClass:self message:#invalidCodeSignal.
	InvalidCodeSignal notifierString:'invalid code-object - not executable'.
    ]
! !

!ExecutableFunction class methodsFor:'signal access'!

executionErrorSignal
    "return the parent-signal of all execution errors"

    ^ ExecutionErrorSignal
! !

!ExecutableFunction methodsFor:'accessing'!

instVarAt:index
    "have to catch instVar access to code - since its no object"

    (index == 1) ifTrue:[^ self code].
    ^ super instVarAt:index
!

instVarAt:index put:value
    "have to catch instVar access to code - since its no object"

    (index == 1) ifTrue:[^ self code:value].
    ^ super instVarAt:index put:value
!

code
    "return the code field. This is not an object but the address of the machine instructions. 
     Therefore an integer representing the code-address is returned"

%{  /* NOCONTEXT */

    if (_INST(code_) != nil) {
	RETURN ( _MKSMALLINT((int)(_INST(code_))) )
    }
%}
.
    ^ nil
! !

!ExecutableFunction methodsFor:'private accessing'!

code:anAddress
    "set the code field - DANGER ALERT. 
     This is not an object but the address of the machine instructions.
     Therefore the argument must be an integer representing this address.
     You can crash Smalltalk very badly when playing around here ...
     This method is for compiler support and very special cases (debugging) only
     - do not use"

%{  /* NOCONTEXT */
    if (__isSmallInteger(anAddress))
	_INST(code_) = (OBJ)(_intVal(anAddress));
    else
	_INST(code_) = (OBJ)0;
%}
!

dynamic:aBoolean
    "set the flag bit stating that the machine code was created
     dynamically and should be flushed on image-restart.
     Obsolete - now done in VM"

%{  /* NOCONTEXT */
    int newFlags = _intVal(_INST(flags));

    /* made this a primitive to get define in stc.h */
    if (aBoolean == true)
	newFlags |= F_DYNAMIC;
    else
	newFlags &= ~F_DYNAMIC;

    _INST(flags) = _MKSMALLINT(newFlags);
%}
! !

!ExecutableFunction methodsFor:'error handling'!

invalidCode
    "this error is triggered by the interpreter when something is wrong
     with the code object (any error not handled by Method-signals).
     In this case, the VM sends this to the bad method/block (the receiver).
     Can only happen when the Compiler/runtime system is broken or
     someone played around."

    ^ InvalidCodeSignal raise.
! !

!ExecutableFunction methodsFor:'binary storage'!

readBinaryContentsFrom: stream manager: manager
    "make certain, that no invalid function addresses are created."

    super readBinaryContentsFrom: stream manager: manager.
    self code:nil.
! !