Method.st
author Claus Gittinger <cg@exept.de>
Sat, 18 Jan 1997 00:30:21 +0100
changeset 2201 db0f6e86c8bb
parent 2176 1a24b0cef25a
child 2218 93c4cb83372a
permissions -rw-r--r--
COMMA_SENDER arg is no longer supported / needed

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

CompiledCode subclass:#Method
	instanceVariableNames:'source sourcePosition category package'
	classVariableNames:'PrivateMethodSignal LastFileReference LastSourceFileName
		LastWhoClass LastFileLock'
	poolDictionaries:''
	category:'Kernel-Methods'
!

Object subclass:#MethodWhoInfo
	instanceVariableNames:'myClass mySelector'
	classVariableNames:''
	poolDictionaries:''
	privateIn:Method
!

!Method 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
"
    this class defines protocol for executable methods;
    both compiled and interpreted methods are represented by this class.
    Compiled methods have a non-nil code field, while interpreted methods have
    a nil code field and non-nil byteCode field.
    If there are both non-nil code and bytecode fields, the VM will execute
    the machine-code of a method. If both are nil when executed, a noByteCode
    message is sent by the VM to the method where a signal is raised.

    The methods sourcecode is represented by source and sourcePosition:
    - if sourcePosition is a Number, the source-field is the fileName and
      sourcePosition is the character offset of the source-chunk in this source file.
    - If sourcePosition is nil, the source is the string in the source field.
    (an old version used ExternalString instances here, but that lead to
     10000 additional little objects ...)

    The flags field defines things like the number of method-locals,
    method arguments and stack requirements (for interpreted methods).
    Do not depend on any value in the flags field - it may change without
    notice.

    Notice, that in ST/X, method can be subclassed; executable code is
    identified not by being a subclass of Block or Method, but instead by
    having the executable flag bit set in the class. The VM can execute anything
    which is identified as executable (assuming that the first instance variable
    is the machine-code address) - this allows for easy future extension.

    [Instance variables:]

        source          <String>        the source itself (if sourcePosition isNil)
                                        or the fileName where the source is found

        sourcePosition  <Integer>       the position of the methods chunk in the file

        category        <Symbol>        the methods category
        package         <Symbol>        the package, in which the methods was defined


    [Class variables:]

        PrivateMethodSignal             raised on privacy violation (see docu)

        LastFileReference               weak reference to the last sourceFile
        LastSourceFileName              to speedup source access via NFS

    WARNING: layout known by compiler and runtime system - dont change

    [author:]
        Claus Gittinger
"
!

dynamicMethods
"
    On systems which support dynamic loading of machine code (SYS5.4, Linux),
    methods may now be compiled to machine code from within the browser,
    and the resulting machine code object be loaded in.
    The ObjectFileLoader keeps (weak) handles to the resulting methods and
    invalidates the corresponding method objects, if the underlying methods
    object code is unloaded.
    Invalid methods will trap into the debugger when executed;
    also, the browser marks them as '(* not executable *)' in its method list.
"
!

privacy 
"
    ST/X includes an EXPERIMENTAL implementation of method privacy.
    Individual methods may be set to private or protected via the
    #setPrivate and #setProtected messages. Also, categories may be
    filedIn as a whole as private using #privateMethodsFor: or as
    protected using #protectedMethodsFor: instead of the well known #methodsFor:.

    The additional #publicMethodsFor: is for documentation purposes, and
    is equivalent to #methodsFor: (also to support fileIn of ENVY methods).

    Private methods may be executed only when called via a self or super-send
    from the superclass, the class itself or subclasses.
    Protected methods may not be called from subclasses, i.e. they may only
    be called via self sends from within the current class.
    (i.e. private methods are less private than protected ones)

    When such a situation arises, the VM (runtime system) will raise the
    PrivateMethodSignal exception (if nonNil), which usually brings you into the
    debugger.

    If PrivateMethodSignal is nil, the VM will not check for this, and
    execution is as usual. (you may want to nil-it for production code,
    and leave it non nil during development).

    NOTICE: there is no (not yet ?) standard defined for method privacy,
    however, the interface was designed to be somewhat ENVY compatible (from
    what can be deduced by reading PD code).
    Also, the usability of privacy is still to be tested.
    This interface, the implementation and the rules for when a privacy violation
    may change (in case of some ANSI standard being defined).
    Be warned and send me suggestions & critics (constructive ;-)
"
! !

!Method class methodsFor:'initialization'!

initialize
    "create signals"

    PrivateMethodSignal isNil ifTrue:[
        "EXPERIMENTAL"
        PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.
        PrivateMethodSignal nameClass:self message:#privateMethodSignal.
        PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
    ].

    LastFileLock isNil ifTrue:[
        LastFileLock := Semaphore forMutualExclusion.
        LastFileReference := WeakArray new:1.
        LastFileReference at:1 put:0.
    ].

    "Modified: 22.4.1996 / 16:34:38 / cg"
    "Modified: 3.1.1997 / 16:58:16 / stefan"
! !

!Method class methodsFor:'Signal constants'!

privateMethodSignal
    "return the signal raised when a private/protected method is called
     by some other object (i.e. not a self- or super send)"

    ^ PrivateMethodSignal
! !

!Method class methodsFor:'binary storage'!

binaryDefinitionFrom: stream manager: manager
    "read my definition from stream."

    |cls sel|

    "type-byte"
    stream nextByte == 0 ifTrue:[
	"
	 built-in method
	"
	cls := manager nextObject.
	sel := manager nextObject.

	"
	 mhmh - on the source system, this was a machinecode
	 method, while here its an interpreted one ...
	"
	cls isLoaded ifFalse:[
	    cls autoload
	].
	^ cls compiledMethodAt:sel
    ].
    "
     bytecode method
    "
    ^ super binaryDefinitionFrom:stream manager:manager
!

binaryFullDefinitionFrom:stream manager:manager
    "retrieve a full bytecoded-method."

    |snapId cat flags code lits m sourceFilename sourcePos source|

    snapId := manager nextObject.
    cat := manager nextObject.
    flags := manager nextObject.
    lits := manager nextObject.
    sourceFilename := manager nextObject.
    sourcePos := manager nextObject.
    sourcePos isNil ifTrue:[
        source := manager nextObject.
    ].
    code := manager nextObject.

    snapId == ObjectMemory snapshotID ifTrue:[
        ObjectMemory incrementSnapshotID
    ].

    m := Method basicNew:(lits size).
    cat notNil ifTrue:[m category:cat].
    m flags:flags.
    m literals:lits.
    m byteCode:code.
    sourcePos isNil ifTrue:[
        m source:source
    ] ifFalse:[
        m sourceFilename:sourceFilename position:sourcePos
    ].
    ^ m

    "Created: 16.1.1996 / 14:44:08 / cg"
    "Modified: 24.6.1996 / 12:29:35 / stefan"
    "Modified: 5.1.1997 / 01:09:56 / cg"
! !

!Method 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 == Method

    "Modified: 23.4.1996 / 15:59:50 / 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));
%}
!

methodPrivacySupported
    "return true, if the system was compiled to support methodPrivacy.
     You should not depend on that feature being available."

%{  /* NOCONTEXT */
#if defined(F_PRIVATE) || defined(F_CLASSPRIVATE)
    RETURN (true);
#else
    RETURN (false);
#endif
%}
! !

!Method class methodsFor:'special'!

flushSourceStreamCache
    LastSourceFileName := nil

    "Created: 9.2.1996 / 19:05:28 / cg"
! !

!Method methodsFor:'accessing'!

category
    "return the methods category or nil"

    ^ category
!

category:aStringOrSymbol
    "set the methods category"

    category := aStringOrSymbol asSymbol
!

comment
    "return the methods comment.
     This is done by searching for and returning the first comment
     from the methods source (excluding any double-quotes). 
     Returns nil if there is no comment (or source is not available)."

    |src comments parser|

    src := self source.
    src isNil ifTrue:[^ nil].

    parser := Parser for:src in:nil.
    parser ignoreErrors; ignoreWarnings; saveComments:true.
    parser parseMethodSpec.
    comments := parser comments.
    comments size == 0 ifTrue:[^ nil].
    (comments first withoutSpaces endsWith:'}') ifTrue:[
        ^ comments at:2 ifAbsent:nil
    ].
    ^ comments first.

    "
     (Method compiledMethodAt:#comment) comment  
     (Object class compiledMethodAt:#infoPrinting:) comment  
    "

    "Modified: 5.1.1997 / 14:35:16 / cg"
!

decompiledSource
    |s|

    s := '' writeStream.
    self decompileTo:s.
    ^ s contents

    "Created: 3.7.1996 / 10:12:31 / cg"
!

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: 8.3.1996 / 13:20:48 / cg"
!

getSource
    ^ source
!

localSourceFilename:aFileName position:aNumber
    "set the methods sourcefile/position indicating, that 
     this is a local file."

    source := aFileName.
    sourcePosition := aNumber negated

    "Created: 16.1.1997 / 01:25:52 / cg"
!

numArgs
    "return the number of arguments, the method expects." 

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

    RETURN (__MKSMALLINT((__intVal(__INST(flags)) & F_NARGS) >> F_NARGSHIFT));
%}.
    "
     The old implementation simply counted the arguments from
     the methods source - new versions include this information
     in the flag instVar, for more security in #perform:
    "

    "
     (Method compiledMethodAt:#source) numArgs  
     (Method compiledMethodAt:#source:) numArgs 
    "
!

numberOfMethodArgs
    "return the number of arguments, the method expects.
     This method is left for backward compatibility - use #numArgs." 

    ^ self numArgs

    "Modified: 4.11.1996 / 21:42:08 / cg"
!

numberOfMethodVars
    "return the number of method local variables. 
     This method is left for backward compatibility - use #numVars." 

    ^ self numVars

    "Modified: 4.11.1996 / 21:42:21 / cg"
!

package
    "return the package-symbol"

    ^ package
!

package:aSymbol
    "set the package-symbol"

    package := aSymbol
!

source
    "return the sourcestring for the receiver"

    |aStream fileName junk who myClass mgr className|

    "
     if sourcePosition is nonNil, its the fileName and
     abs(sourcePosition) is the offset.
     Otherwise, source is the real source
    "
    sourcePosition isNil ifTrue:[^ source].

    source notNil ifTrue:[
"/
"/ original (old) code:
"/
"/        aStream := Smalltalk systemFileStreamFor:('source/' , source).
"/        aStream notNil ifTrue:[
"/            aStream position:sourcePosition.
"/            junk := aStream nextChunk.
"/            aStream close
"/        ]

        "/ keep the last source file open, because open/close
        "/ operations maybe slow on NFS-mounted file systems.
        "/ Since the reference to the file is weak, it will be closed
        "/ automatically if the file is not referenced for a while. 
        "/ Neat trick.

        LastFileLock critical:[
            aStream := LastFileReference at:1.
            LastFileReference at:1 put:0.

            aStream == 0 ifTrue:[
                aStream := nil.
            ] ifFalse:[
                LastSourceFileName = source ifFalse:[
                    aStream close.
                    aStream := nil.
                ].
            ].
        ].

        "/ a negative sourcePosition indicates
        "/ that this is a local file (not to be requested
        "/ via the sourceCodeManager)
        "/ This kludge was added, to allow sourceCode to be
        "/ saved to a local source file (i.e. 'st.src')
        "/ and having a clue for which file is meant later.

        sourcePosition < 0 ifTrue:[
            aStream := source asFilename readStream.
            aStream isNil ifTrue:[
                fileName := Smalltalk getSourceFileName:source.
                fileName notNil ifTrue:[
                    aStream := fileName asFilename readStream.
                ].
            ].
        ].

        aStream isNil ifTrue:[
            "/
            "/ if there is no SourceManager, look in standard places
            "/ first
            "/
            (mgr := Smalltalk at:#SourceCodeManager) isNil ifTrue:[
                fileName := Smalltalk getSourceFileName:source.
                fileName notNil ifTrue:[
                    aStream := fileName asFilename readStream.
                ].
            ].

            aStream isNil ifTrue:[
                "/
                "/ nope - ask my class for the source (this also invokes the SCMgr)
                "/
                who := self who.
                who notNil ifTrue:[
                    myClass := who methodClass.
                    aStream := myClass sourceStreamFor:source.

"/ the check below is no good -
"/ the classes stream may be an HTTP-stream, cached fileStream
"/ or whatever ...
"/
"/                    aStream pathName asFilename baseName ~= source asFilename baseName
"/                    ifTrue:[
"/                        "/ oops - not really
"/                        'Method [info]: do not trust my classes source' infoPrintCR.
"/                        aStream close.
"/                        aStream := nil.
"/                    ]
                ].

                aStream isNil ifTrue:[
                    "/
                    "/ nope - look in standard places 
                    "/ (if there is a source-code manager - otherwise, we already did that)
                    "/
                    mgr notNil ifTrue:[
                        fileName := Smalltalk getSourceFileName:source.
                        fileName notNil ifTrue:[
                            aStream := fileName asFilename readStream.
                        ]
                    ].

                    "/
                    "/ final chance: try current directory
                    "/
                    aStream isNil ifTrue:[
                        aStream := source asFilename readStream.
                    ]
                ].

                (aStream isNil and:[who isNil and:[source notNil]]) ifTrue:[
                    "/
                    "/ mhmh - seems to be a method which used to be in some
                    "/ class, but has been overwritten by another or removed.
                    "/ (i.e. it has no containing class anyMore)
                    "/ try to guess the class from the sourceFileName.
                    "/ and retry.
                    "/
                    className := Smalltalk classNameForFile:source.
                    className knownAsSymbol ifTrue:[
                        myClass := Smalltalk at:className asSymbol ifAbsent:nil.
                        myClass notNil ifTrue:[
                            aStream := myClass sourceStreamFor:source.
                        ]
                    ]
                ]                
            ]
        ].

        aStream notNil ifTrue:[
            aStream position:sourcePosition abs.
            junk := aStream nextChunk.

            "
             keep a weak reference - it may be needed again soon ...
            "
            LastFileLock critical:[
                (LastFileReference at:1) == 0 ifTrue:[
                    LastFileReference at:1 put:aStream.
                    LastSourceFileName := source.
                ] ifFalse:[
                    aStream close.
                ].
            ].
        ]
    ].
    ^ junk

    "Modified: 7.1.1997 / 16:20:09 / stefan"
    "Modified: 16.1.1997 / 01:25:14 / cg"
!

source:aString
    "set the methods sourcestring"

    source := aString.
    sourcePosition := nil
!

sourceFilename
    "return the sourcefilename if source is extern; nil otherwise"

    sourcePosition notNil ifTrue:[^ source].
    ^ nil
!

sourceFilename:aFileName position:aNumber
    "set the methods sourcefile/position"

    source := aFileName.
    sourcePosition := aNumber
!

sourcePosition
    "return the sourceposition if source is extern; nil otherwise"

    sourcePosition isNil ifTrue:[^ sourcePosition].
    ^ sourcePosition abs

    "Modified: 16.1.1997 / 01:28:25 / cg"
! !

!Method methodsFor:'accessing-visibility'!

isIgnored
    "return true, if this is an ignored method.
     Ignored methods are physically present in the source file,
     but no code is generated for it by stc, and the VM does not see
     it in its message lookup.
     (i.e. setting a method to #ignored, and sending that selector,
      leads to either the superclasses implementation to be called, 
      or a doesNotUnderstand exception to be raised)

     Notice: this is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
#if defined(F_IGNORED) && defined(M_PRIVACY)
    int f = __intVal(__INST(flags));

    if ((f & M_PRIVACY) == F_IGNORED) {
	RETURN (true);
    }
#endif
%}.
    ^ false
!

isPrivate
    "return true, if this is a private method.
     Execution of private methods is only allowed via self/super sends
     from superclasses, the class itself or subclasses.
     If a private method is called by some other class, a runtime
     error (PrivateMethodSignal) is raised.
     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
    /* I made this a primitive to get the define constant from stc.h */

#if defined(F_PRIVATE) && defined(M_PRIVACY)
    int f = __intVal(__INST(flags));

    if ((f & M_PRIVACY) == F_PRIVATE) {
	RETURN (true);
    }
#endif
%}.
    ^ false
!

isProtected
    "return true, if this is a protected method.
     Execution of protected methods is only allowed via self sends
     from superclasses or the class itself.
     If a protected method is called by some other class, a runtime
     error (PrivateMethodSignal) is raised.

     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
    /* I made this a primitive to get the define constant from stc.h */

#if defined(F_CLASSPRIVATE) && defined(M_PRIVACY)
    int f = __intVal(__INST(flags));

    if ((f & M_PRIVACY) == F_CLASSPRIVATE) {
	RETURN (true);
    }
#endif
%}.
    ^ false
!

isPublic
    "return true, if this is a public method - I.e. can be executed via any send.
     This is the default and how other smalltalk implementations treat all methods.

     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
    /* I made this a primitive to get the define constant from stc.h */

#if defined(M_PRIVACY) && (defined(F_PRIVATE) || defined(F_CLASSPRIVATE) || defined(F_IGNORED))

    int f = __intVal(__INST(flags));
# ifdef F_PRIVATE
    if ((f & M_PRIVACY) == F_PRIVATE) {
	RETURN (false);
    }
# endif
# ifdef F_CLASSPRIVATE
    if ((f & M_PRIVACY) == F_CLASSPRIVATE) {
	RETURN (false);
    }
# endif
# ifdef F_IGNORED
    if ((f & M_PRIVACY) == F_IGNORED) {
	RETURN (false);
    }
# endif
#endif
%}.
    ^ true
!

isRestricted
    "return the flag bit stating that this method is restricted.
     Execution of the receiver will only be allowed if the system is not in
     'trap restricted mode' (-->ObjectMemory) otherise a runtime 
     error (PrivateMethodSignal) is raised.

     Notice: method restriction is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
#ifdef F_RESTRICTED
    int f = __intVal(__INST(flags));

    if (f & F_RESTRICTED) {
	RETURN (true);
    }
#endif
%}.
    ^ false
!

privacy
    "return a symbol describing the methods access rights (privacy);
     Currently, this is one of #private, #protected, #public or #ignored.

     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.
     If at all, use it for debugging purposes, to catch messagesends
     which are not supposed to be sent by others.
     (especially, if working in a team, while integrating other peoples work)

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

    self isPrivate ifTrue:[^ #private].
    self isProtected ifTrue:[^ #protected].
    self isIgnored ifTrue:[^ #ignored].
    ^ #public

    "Modified: 27.8.1995 / 22:53:31 / claus"
!

privacy:aSymbol
    "set the methods access rights (privacy) from a symbol;
     Currently, this must be one of #private, #protected, #public or #ignored.

     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.
     If at all, use it for debugging purposes, to catch messagesends
     which are not supposed to be sent by others.
     (especially, if working in a team, while integrating other peoples work)

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

    aSymbol == #public ifTrue:[
	"/
	"/ no need to flush, if changing from private to public
	"/
	self isIgnored ifFalse:[
	    ^ self setToPublic
	].
	self setToPublic
    ] ifFalse:[
	aSymbol == #private ifTrue:[
	    self setToPrivate
	] ifFalse:[
	    aSymbol == #protected ifTrue:[
		self setToProtected
	    ] ifFalse:[
		aSymbol == #ignored ifTrue:[
		    self setToIgnored
		]
	    ]
	]
    ].
    ObjectMemory flushCaches.

    "Modified: 27.8.1995 / 22:58:08 / claus"
!

restricted:aBoolean
    "set or clear the flag bit stating that this method is restricted. 
     Execution of the receiver will only be allowed if the system is not in
     'trap restricted mode' (-->ObjectMemory) otherise a runtime
     error (PrivateMethodSignal) is raised.

     Notice: method restriction is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
    /* I made this a primitive to get the define constant from stc.h */

#ifdef F_RESTRICTED
    int f = __intVal(__INST(flags));
    int old;

    old = f;
    if (aBoolean == true) 
	f |= F_RESTRICTED;
    else
	f &= ~F_RESTRICTED;
    __INST(flags) = __MKSMALLINT(f);
    if (old & F_RESTRICTED)
	RETURN(true);
#endif
%}.
    ^ false

    "
     (ObjectMemory class compiledMethodAt:#compressingGarbageCollect) restricted:true
    "

    "Created: 7.11.1995 / 20:36:19 / stefan"
!

setToIgnored
    "make this method be ignored w.r.t. method lookup.
     (i.e. setting a method to #ignored, and sending that selector,
      leads to either the superclasses implementation to be called, 
      or a doesNotUnderstand exception to be raised)

     Notice: ignored methods are a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
    int f = __intVal(__INST(flags));

#if defined(F_IGNORED) && defined(M_PRIVACY)
    f = (f & ~M_PRIVACY) | F_IGNORED;
#endif
    __INST(flags) = __MKSMALLINT(f);
%}
!

setToPrivate
    "set the flag bit stating that this method is private. 
     Execution of the receiver will only be allowed for self/super-sends from 
     the class, superclasses or subclasses (or via #perform).
     If a private method is called by some other class, a runtime
     error (PrivateMethodSignal) is raised.

     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.
     If at all, use it for debugging purposes, to catch messagesends
     which are not supposed to be sent by others.
     (especially, if working in a team, while integrating other peoples work)

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
    /* I made this a primitive to get the define constant from stc.h */

#if defined(F_PRIVATE) && defined(M_PRIVACY)
    int f = __intVal(__INST(flags));

    f = (f & ~M_PRIVACY) | F_PRIVATE;
    __INST(flags) = __MKSMALLINT(f);
#endif
%}
!

setToProtected
    "set the flag bit stating that this method is protected. 
     Execution of the receiver will only be allowed for self sends from
     the class or superclasses. (or via #perform).
     If a private method is called by some other class, a runtime
     error (PrivateMethodSignal) is raised.

     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.
     If at all, use it for debugging purposes, to catch messagesends
     which are not supposed to be sent by others.
     (especially, if working in a team, while integrating other peoples work)

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
    /* I made this a primitive to get the define constant from stc.h */

#if defined(F_CLASSPRIVATE) && defined(M_PRIVACY)
    int f = __intVal(__INST(flags));

    f = (f & ~M_PRIVACY) | F_CLASSPRIVATE;
    __INST(flags) = __MKSMALLINT(f);
#endif
%}
!

setToPublic
    "clear any privacy/ignoreFlag of the receiver. 
     The receiver may be executed by any send. 
     This is the default anyway for methods, and how other smalltalk
     implementations treat all methods.

     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.
     If at all, use it for debugging purposes, to catch messagesends
     which are not supposed to be sent by others.
     (especially, if working in a team, while integrating other peoples work)

     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

%{  /* NOCONTEXT */
    /* I made this a primitive to get the define constant from stc.h */

#ifdef M_PRIVACY
    int f = __intVal(__INST(flags));

    f = f & ~M_PRIVACY;
    __INST(flags) = __MKSMALLINT(f);
#endif
%}
! !

!Method methodsFor:'binary storage'!

asByteCodeMethod
    "if the receiver has no bytecodes, create & return a method having
     the same semantics as the receiver, but uses interpreted bytecodes.
     Otherwise, return the receiver. The new method is not installed in
     the methodDictionary of any class - just returned.
     If the method contains primitive code, this may return a method
     without bytecode.
     Can be used to obtain a bytecode version of a machine-code method, 
     for binary storage or dynamic recompilation (which is not yet finished)
     or to compile lazy methods down to executable ones."

    |doMachineCode mthd|

    byteCode notNil ifTrue:[
        "
         is already a bytecoded method
        "
        ^ self
    ].
    doMachineCode := Compiler stcCompilation:#never.
    [
        mthd := self asExecutableMethod.
    ] valueNowOrOnUnwindDo:[
        Compiler stcCompilation:doMachineCode.
    ].
    ^ mthd

    "Created: 24.10.1995 / 14:02:32 / cg"
    "Modified: 5.1.1997 / 01:01:53 / cg"
!

asExecutableMethod
    "if the receiver has neither bytecodes nor machinecode, create & return a 
     method having semantics as the receivers source. This may be machine code,
     if the system supports dynamic loading of object code and the source includes
     primitive code. However, bytecode is preferred, since it compiles faster.
     Otherwise, return the receiver. The new method is not installed in
     the methodDictionary of any class - just returned.
     Can be used to compile lazy methods down to executable ones."

    |temporaryMethod cls sourceString silent lazy|

    byteCode notNil ifTrue:[
        "
         is already a bytecoded method
        "
        ^ self
    ].

    cls := self containingClass.
    cls isNil ifTrue:[
        'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
        ^ nil
    ].
    sourceString := self source.
    sourceString isNil ifTrue:[
        'Method [warning]: cannot generate bytecode (no source for compilation)' errorPrintCR.
        ^ nil
    ].

    "
     dont want this to go into the changes file,
     dont want output on Transcript and definitely 
     dont want a lazy method ...
    "
    Class withoutUpdatingChangesDo:[
        silent := Smalltalk silentLoading:true.
        lazy := Compiler compileLazy:false.

        [
            |compiler|

            compiler := cls compilerClass.

            "/
            "/ kludge - have to make ST/X's compiler protocol
            "/ be compatible to ST-80's
            "/
            (compiler respondsTo:#compile:forClass:inCategory:notifying:install:skipIfSame:)
            ifTrue:[
                temporaryMethod := compiler
                                     compile:sourceString
                                     forClass:cls
                                     inCategory:(self category)
                                     notifying:nil
                                     install:false.
            ] ifFalse:[
                temporaryMethod := compiler new
                                     compile:sourceString 
                                     in:cls 
                                     notifying:nil 
                                     ifFail:nil
            ].
        ] valueNowOrOnUnwindDo:[
            Compiler compileLazy:lazy.
            Smalltalk silentLoading:silent.
        ]
    ].
    (temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
        'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
        ^ nil.
    ].
    "
     try to save a bit of memory, by sharing the source (whatever it is)
    "
    temporaryMethod sourceFilename:source position:sourcePosition. 
    ^ temporaryMethod

    "Created: 24.10.1995 / 14:02:30 / cg"
    "Modified: 10.1.1997 / 17:55:33 / cg"
!

readBinaryContentsFrom: stream manager: manager
    self code notNil ifTrue:[
        "built-in method - already complete"
        ^ self
    ].

    ^ super readBinaryContentsFrom: stream manager: manager

    "Modified: 5.1.1997 / 01:02:43 / cg"
!

storeBinaryDefinitionOn:stream manager:manager
    "store the receiver in a binary format on stream.
     This is an internal interface for binary storage mechanism.
     only store bytecode-methods - machinecode methods are stored
     as class/selector pair and a lookup is done when restored.

     If the receiver method is a built-in (i.e. machine coded)
     method, a temporary interpreted byte code method is created,
     and its bytecode stored. 
     This works only, if the source of the method is available and the
     method does not contain primitive code."

    |storedMethod who|

    byteCode isNil ifTrue:[
        self code notNil ifTrue:[
            (who := self who) notNil ifTrue:[
                "
                 machine code only - assume its a built-in method,
                 and store the class/selector information.
                 The restored method may not be exactly the same ...
                "
                manager putIdOfClass:(self class) on:stream.
                stream nextPutByte:0.   "means: built-in method" 
                manager putIdOf:(who methodClass) on:stream.
                manager putIdOf:(who methodSelector) on:stream.
                ^ self
            ]
        ].

        storedMethod := self asByteCodeMethod.
        storedMethod isNil ifTrue:[
            self error:'store of built-in method failed'.
            ^ nil
        ].
        ^ storedMethod storeBinaryDefinitionOn:stream manager:manager
    ].

    manager putIdOfClass:(self class) on:stream.
    stream nextPutByte:1.       "means: byte-coded method"
    self storeBinaryDefinitionBodyOn:stream manager:manager

    "Modified: 1.11.1996 / 16:26:45 / cg"
!

storeFullBinaryDefinitionOn:stream manager:manager
    "store full bytecoded-method."

    |m code srcPos|

    "/ need a byteCode version of myself ...
    m := self.
    code := byteCode.
    code isNil ifTrue:[
        m := self asByteCodeMethod.
        code := m byteCode.
        code isNil ifTrue:[
            m := self
        ]
    ].

    ObjectMemory snapshotID storeBinaryOn:stream manager:manager.
    category storeBinaryOn:stream manager:manager.

    m flags storeBinaryOn:stream manager:manager.
    m literals storeBinaryOn:stream manager:manager.
    manager sourceMode == #discard ifTrue:[
        "/ add nil, nil, nil
        nil storeBinaryOn:stream manager:manager. "/ sourceFileName
        nil storeBinaryOn:stream manager:manager. "/ sourcePosition
        nil storeBinaryOn:stream manager:manager. "/ source
    ] ifFalse:[
        "/ add sourceFilename, srcPos
        "/ or  nil, nil, source
        m sourceFilename storeBinaryOn:stream manager:manager.
        manager sourceMode == #reference ifTrue:[
            srcPos := m sourcePosition.
        ] ifFalse:[
            srcPos := nil
        ].
        srcPos storeBinaryOn:stream manager:manager.
        srcPos isNil ifTrue:[
            m source storeBinaryOn:stream manager:manager.
        ].
    ].

    code storeBinaryOn:stream manager:manager.

    "Created: 16.1.1996 / 14:41:45 / cg"
    "Modified: 5.1.1997 / 00:39:29 / cg"
! !

!Method methodsFor:'copying'!

copy
    "redefined to change a source ref into a real string"

    |aCopy|

    aCopy := super copy.
    sourcePosition notNil ifTrue:[
        aCopy source:(self source)
    ].
    ^ aCopy

    "Modified: 16.1.1997 / 01:27:25 / cg"
! !

!Method methodsFor:'error handling'!

invalidCodeObject
    "{ Pragma: +optSpace }"

    "this method is triggered by the interpreter when a nil or non method
     is about to be executed.
     In this case, the VM sends this to the bad method (the receiver).

     Also, the Compiler creates methods with their code/bytecode set to
     this method if - after a class change - a method cannot be compiled
     and is therefore no longer executable (for example, after an instvar
     has been removed, and a method still tries to access this instvar)

     Thus, we arrive here, when playing around in a classes methodArray,
     or compiler/runtime system is broken :-(, 
     or you ignore the error messages during some recompile."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Modified: 4.11.1996 / 22:45:06 / cg"
!

invalidCodeObjectWith:arg
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 1 arg) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:16:16 / cg"
    "Modified: 4.11.1996 / 22:45:12 / cg"
!

invalidCodeObjectWith:arg with:arg2
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 2 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:16:41 / cg"
    "Modified: 4.11.1996 / 22:45:15 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 3 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:16:51 / cg"
    "Modified: 4.11.1996 / 22:45:18 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 4 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:17:00 / cg"
    "Modified: 4.11.1996 / 22:45:22 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 5 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:17:09 / cg"
    "Modified: 4.11.1996 / 22:45:25 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 6 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:17:17 / cg"
    "Modified: 4.11.1996 / 22:45:28 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 7 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:17:25 / cg"
    "Modified: 4.11.1996 / 22:45:31 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7 with:arg8
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 8 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:17:32 / cg"
    "Modified: 4.11.1996 / 22:45:38 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7 with:arg8 with:arg9
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 9 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:17:37 / cg"
    "Modified: 4.11.1996 / 22:45:41 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7 with:arg8 with:arg9 with:arg10
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 10 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:17:45 / cg"
    "Modified: 4.11.1996 / 22:45:44 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7 with:arg8 with:arg9 with:arg10 with:arg11
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 11 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:17:52 / cg"
    "Modified: 4.11.1996 / 22:45:47 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7 with:arg8 with:arg9 with:arg10 with:arg11 with:arg12
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 12 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 20:51:28 / cg"
    "Modified: 4.11.1996 / 22:46:01 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7 with:arg8 with:arg9 with:arg10 with:arg11 with:arg12 with:arg13
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 13 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:18:09 / cg"
    "Modified: 4.11.1996 / 22:45:57 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7 with:arg8 with:arg9 with:arg10 with:arg11 with:arg12 with:arg13 with:arg14
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 14 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:18:17 / cg"
    "Modified: 4.11.1996 / 22:45:55 / cg"
!

invalidCodeObjectWith:arg with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7 with:arg8 with:arg9 with:arg10 with:arg11 with:arg12 with:arg13 with:arg14 with:arg15
    "{ Pragma: +optSpace }"

    "When recompiling classes after a definition-change, all
     uncompilable methods (with 15 args) will be bound to this method here,
     so that evaluating such an uncompilable method will trigger an error."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseErrorString:'invalid method - not executable'.

    "Created: 4.11.1996 / 21:18:22 / cg"
    "Modified: 4.11.1996 / 22:45:52 / cg"
!

privateMethodCalled
    "{ Pragma: +optSpace }"

    "this error is triggered, if a private or protected method is called.

     If you continue in the debugger, the method will be called,
     and further privacy exceptions will NOT be reported at this call location, 
     until any new method is compiled, or the privacy of any method changes,
     or the caches are flushed.
     (the reason is that after the continue, the method is enterred into the
      calling cache, for which method privacy is not checked.
      Any of the above actions flushes this cache and a privacy check
      is performed again.)
     Future versions may not enter private methods into the cache, to fix this
     (unobvious) behavior. However, then you will get an exception for EVERY
     call to a private method ...

     Notice: method privacy is a nonstandard feature, not supported
     by other smalltalk implementations and not specified in the ANSI spec.
     This is EXPERIMENTAL - and being evaluated for usability.
     It may change or even vanish (if it shows to be not useful)."

    ^ PrivateMethodSignal raise

    "Modified: 4.11.1996 / 22:46:09 / cg"
!

uncompiledCodeObject
    "{ Pragma: +optSpace }"

    "this method is invoked by methods which contain primitive code,
     but have not been compiled to machine code (either due to an error
     when compiling, or simply because no stc is available.
     For those methods, the compiler generated a method object consisting
     of the original source code, but with this methods machine/byte code."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseRequestWith:self
        errorString:'invalid method - not compiled'.

    "Modified: 4.11.1996 / 22:58:02 / cg"
!

unloadedCodeObject
    "{ Pragma: +optSpace }"

    "this method is invoked by methods which have been binary-unloaded
     For those the source info consists
     of the original source code, but with this methods machine/byte code."

%{
    /*
     * for reasons too far from being explained here,
     * this MUST be a compiled method
     */
%}.
    ^ InvalidCodeSignal
        raiseRequestWith:self
        errorString:'invalid method - unloaded'.

    "Created: 4.11.1996 / 22:57:54 / cg"
    "Modified: 4.11.1996 / 22:58:28 / cg"
!

wrongNumberOfArguments:numberGiven
    "{ Pragma: +optSpace }"

    "this error is triggered, if a method is called with a wrong number
     of arguments. This only applies to #valueWithReceiverXXX - sends.
     With a normal send, this error cannot happen."

    ^ ArgumentSignal
        raiseRequestWith:self
        errorString:('method got ' , numberGiven printString ,
                     ' args while ' , self numberOfMethodArgs printString , ' where expected')

    "Modified: 4.11.1996 / 22:46:16 / cg"
! !

!Method methodsFor:'executing'!

valueWithReceiver:anObject arguments:argArray
    "low level call of a methods code - BIG DANGER ALERT.
     Perform the receiver-method on anObject as receiver and argArray as
     arguments. This does NO message lookup at all and mimics a
     traditional function call.
     This method is provided for debugging- and breakpoint-support 
     (replacing a method by a stub and recalling the original), or to implement
     experimental MI implementations - it is not for general use. 

     The receiver must be a method compiled in anObjects class or one of its 
     superclasses and also, the number of arguments given must match the methods
     expectations -
     - otherwise strange things (and also strange crashes) can occur.
     The system is NOT always detecting a wrong method/receiver combination.
     YOU HAVE BEEN WARNED."

    ^ self valueWithReceiver:anObject arguments:argArray selector:nil search:nil
!

valueWithReceiver:anObject arguments:argArray selector:aSymbol
    "low level call of a methods code - BIG DANGER ALERT.
     Perform the receiver-method on anObject as receiver and argArray as
     arguments. This does NO message lookup at all and mimics a
     traditional function call.
     This method is provided for debugging- and breakpoint-support 
     (replacing a method by a stub and recalling the original), or to implement
     experimental MI implementations - it is not for general use. 

     The receiver must be a method compiled in anObjects class or one of its 
     superclasses and also, the number of arguments given must match the methods
     expectations -
     - otherwise strange things (and also strange crashes) can occur.
     The system is NOT always detecting a wrong method/receiver combination.
     YOU HAVE BEEN WARNED."

    ^ self valueWithReceiver:anObject 
		   arguments:argArray 
		    selector:aSymbol 
		      search:nil
		      sender:nil
!

valueWithReceiver:anObject arguments:argArray selector:aSymbol search:aClass
    "low level call of a methods code - BIG DANGER ALERT.
     Perform the receiver-method on anObject as receiver and argArray as
     arguments. This does NO message lookup at all and mimics a
     traditional function call.
     This method is provided for debugging- and breakpoint-support 
     (replacing a method by a stub and recalling the original), or to implement
     experimental MI implementations - it is not for general use. 

     The receiver must be a method compiled in anObjects class or one of its 
     superclasses and also, the number of arguments given must match the methods
     expectations -
     - otherwise strange things (and also strange crashes) can occur.
     The system is NOT always detecting a wrong method/receiver combination.
     YOU HAVE BEEN WARNED."

    ^ self valueWithReceiver:anObject 
		   arguments:argArray 
		    selector:aSymbol 
		      search:nil
		      sender:nil
!

valueWithReceiver:anObject arguments:argArray selector:aSymbol search:aClass sender:virtualSender
    "low level call of a methods code - BIG DANGER ALERT.
     Perform the receiver-method on anObject as receiver and argArray as
     arguments. This does NO message lookup at all and mimics a
     traditional function call.
     This method is provided for debugging- and breakpoint-support 
     (replacing a method by a stub and recalling the original), or to implement
     experimental MI implementations - it is not for general use. 

     The receiver must be a method compiled in anObjects class or one of its 
     superclasses and also, the number of arguments given must match the methods
     expectations -
     - otherwise strange things (and also strange crashes) can occur.
     The system is NOT always detecting a wrong method/receiver combination.
     YOU HAVE BEEN WARNED."

%{
    OBJFUNC code;
    OBJ searchClass;
    static struct inlineCache dummy = _DUMMYILC0;
    int nargs;
    OBJ *ap;

    /*
     * args must be an array, or nil
     */
    if (__isArray(argArray)) {
        nargs = __arraySize(argArray);
        ap = __ArrayInstPtr(argArray)->a_element;
    } else {
        if (argArray != nil) {
            goto badArgs;
        }
        nargs = 0;
    }

#ifdef F_NARGS
    if (((__intVal(__INST(flags)) & F_NARGS) >> F_NARGSHIFT) == nargs) 
#endif
    {
        code = __MethodInstPtr(self)->m_code;
        if (aClass == nil) {
            searchClass = dummy.ilc_class = __Class(anObject);
        } else {
            searchClass = dummy.ilc_class = aClass;
        }

        if (nargs <= 15) {
          /*
           * add virtual sender (unwinding) here later,
           * to allow hiding contexts in lazy methods.
           * (this is cosmetics only; therefore its done later)
           */
          if (code) {
            /* compiled code */
            switch (nargs) {
                case 0:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy) );

                case 1:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, ap[0]) );

                case 2:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, ap[0], ap[1]) );

                case 3:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, ap[0], ap[1], ap[2]) );

                case 4:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3]) );

                case 5:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4]) );

                case 6:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );

                case 7:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );

                case 8:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) );

                case 9:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) );

                case 10:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
                                 ap[9]) );

                case 11:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
                                 ap[9], ap[10]) );

                case 12:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
                                 ap[9], ap[10], ap[11]) );

                case 13:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
                                 ap[9], ap[10], ap[11], ap[12]) );

                case 14:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
                                 ap[9], ap[10], ap[11], ap[12], ap[13]) );

                case 15:
                    RETURN ( (*code)(anObject, aSymbol, searchClass, &dummy, 
                                 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
                                 ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) );
            }
          } else {
            /* interpreted code */
#ifdef PASS_ARG_POINTER
            RETURN ( __interpret(self, nargs, anObject, aSymbol, searchClass, &dummy, ap) );
#else
            switch (nargs) {
                case 0:
                    RETURN ( __interpret(self, 0, anObject, aSymbol, searchClass, &dummy) );

                case 1:
                    RETURN ( __interpret(self, 1, anObject, aSymbol, searchClass, &dummy,
                                   ap[0]) );

                case 2:
                    RETURN ( __interpret(self, 2, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1]) );

                case 3:
                    RETURN ( __interpret(self, 3, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2]) );

                case 4:
                    RETURN ( __interpret(self, 4, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3]) );

                case 5:
                    RETURN ( __interpret(self, 5, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4]) );

                case 6:
                    RETURN ( __interpret(self, 6, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );

                case 7:
                    RETURN ( __interpret(self, 7, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );

                case 8:
                    RETURN ( __interpret(self, 8, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
                                   ap[7]) );

                case 9:
                    RETURN ( __interpret(self, 9, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
                                   ap[7], ap[8]) );

                case 10:
                    RETURN ( __interpret(self, 10, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
                                   ap[7], ap[8], ap[9]) );

                case 11:
                    RETURN ( __interpret(self, 11, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
                                   ap[7], ap[8], ap[9], ap[10]) );

                case 12:
                    RETURN ( __interpret(self, 12, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
                                   ap[7], ap[8], ap[9], ap[11]) );

                case 13:
                    RETURN ( __interpret(self, 13, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
                                   ap[7], ap[8], ap[9], ap[11], ap[12]) );

                case 14:
                    RETURN ( __interpret(self, 14, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
                                   ap[7], ap[8], ap[9], ap[11], ap[12], ap[13]) );

                case 15:
                    RETURN ( __interpret(self, 15, anObject, aSymbol, searchClass, &dummy,
                                   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
                                   ap[7], ap[8], ap[9], ap[11], ap[12], ap[13], ap[14]) );
            }
#endif
          }
        }
    }
    badArgs: ;
%}.
    (argArray isMemberOf:Array) ifFalse:[
        "
         arguments must be either nil or an array
        "
        ^ self badArgumentArray
    ].

    (argArray size ~~ self numArgs) ifTrue:[
        "
         the method expects a different number of arguments
        "
        ^ self wrongNumberOfArguments:argArray size
    ].
    
    "/ the VM only supports a limited number of arguments in sends
    "/ (currently, 15)
    
    ^ self tooManyArguments

    "
     (Float compiledMethodAt:#+) 
        valueWithReceiver:1.0 arguments:#(2.0)

     'the next example is a wrong one - which is detected by True's method ...'.
     (True compiledMethodAt:#printString) 
        valueWithReceiver:false arguments:nil

     'the next example is a wrong one - it is nowhere detected
      and a wrong value returned ...'.
     (Point compiledMethodAt:#x) 
        valueWithReceiver:(1->2) arguments:nil

     'the next example is VERY bad one - it is nowhere detected
      and may crash the system WARNING: save your work before doing this ...'.
     (Point compiledMethodAt:#x) 
        valueWithReceiver:(Object new) arguments:nil

     'the next example is a wrong one - which is detected here ...'.
     (Object compiledMethodAt:#printOn:)
        valueWithReceiver:false arguments:nil

     'the next example is a wrong one - which is detected here ...'.
     (Object compiledMethodAt:#printOn:)
        valueWithReceiver:false arguments:#() 
    "
! !

!Method methodsFor:'printing & storing'!

printOn:aStream
    "put a printed representation of the receiver onto aStream.
     Since methods do not store their class/selector, we have to search
     for it here."

    |classAndSelector m wrapped|

    wrapped := false.

    aStream nextPutAll:(self classNameWithArticle).
    aStream nextPut:$(.

    classAndSelector := self who.
    classAndSelector isNil ifTrue:[
        "
         not anchored in any class.
         check if wrapped (to be more informative in inspectors)
        "
        m := self wrapper.
        m notNil ifTrue:[
            classAndSelector := m who.
            wrapped := true.
        ]
    ].
    classAndSelector notNil ifTrue:[
        (classAndSelector methodClass) name printOn:aStream.
        aStream nextPutAll:' '.
        (classAndSelector methodSelector) printOn:aStream.
        wrapped ifTrue:[
            aStream nextPutAll:'; wrapped'
        ].
    ] ifFalse:[
        "
         sorry, a method which is nowhere anchored
        "
        aStream nextPutAll:'unbound'
    ].
    aStream nextPut:$)

    "
     (Object compiledMethodAt:#at:) printOn:Transcript. Transcript cr.
     (Object compiledMethodAt:#at:) copy printOn:Transcript. Transcript cr.
    "

    "Modified: 1.11.1996 / 16:25:34 / cg"
!

printStringForBrowserWithSelector:selector
    "return a printString to represent myself to the user in a browser.
     Defined here to allow for browsers to deal with nonStandard pseudoMethods"

    |s privInfo moreInfo p i|

    moreInfo := ''.
    privInfo := ''.

    self isWrapped ifTrue:[
        (MessageTracer isCounting:self) ifTrue:[
            (MessageTracer isCountingMemoryUsage:self) ifTrue:[
                moreInfo := moreInfo , 
                     ' (mem usage ' , (MessageTracer memoryUsageOfMethod:self) printString , ' Bytes)'.
            ] ifFalse:[
                moreInfo := moreInfo , 
                     ' (called ' , (MessageTracer executionCountOfMethod:self) printString , ' times)'.
            ]
        ] ifFalse:[
            (MessageTracer isTiming:self) ifTrue:[
                i := MessageTracer executionTimesOfMethod:self.
                i notNil ifTrue:[
                    moreInfo := moreInfo , 
                                ' (avg: ' , (i at:#avgTime) printString,
                                ' min: ' , (i at:#minTime) printString , 
                                ' max: ' , (i at:#maxTime) printString ,
                                ' cnt: ' , (i at:#count) printString , ')'
                ].
            ] ifFalse:[
                moreInfo := ' !!'
            ]
        ].
        p := self originalMethod privacy
    ] ifFalse:[
        p := self privacy
    ].

    p ~~ #public ifTrue:[
        privInfo := (' (* ' , p , ' *)') asText emphasizeAllWith:#italic.
    ].

    self isInvalid ifTrue:[
        moreInfo := ' (** not executable **)'.
    ].

    (self isLazyMethod not and:[self isUnloaded]) ifTrue:[
        moreInfo := ' (** unloaded **)'
    ].

    privInfo size ~~ 0 ifTrue:[
        moreInfo := privInfo , ' ' , moreInfo
    ].

    moreInfo size == 0 ifTrue:[^ selector].

    s := selector , moreInfo.
    self isInvalid ifTrue:[
        s := s asText emphasizeAllWith:#color->Color red.
    ].
    ^ s

    "Created: 16.4.1996 / 20:11:12 / cg"
    "Modified: 23.10.1996 / 21:01:57 / cg"
!

whoString
    "return a string as className>>selector, if this is not an unbound
     method. Otherwise return 'unbound'. Used with debugging."

    |who|

    who := self who.
    who notNil ifTrue:[
        ^ (who methodClass) name , '>>' , (who methodSelector)
    ].
    ^ 'unbound'

    "
     Method new whoString
     (Method compiledMethodAt:#whoString) whoString
    "

    "Modified: 1.11.1996 / 16:27:04 / cg"
! !

!Method methodsFor:'private-compiler interface'!

flags:newFlags
    "set the flags (number of method variables, stacksize).
     WARNING: for internal use by the compiler only.
              playing around here with incorrect values 
              may crash smalltalk badly.

     Dont depend on the values in the flag field - its interpretations
     may change without notice."

    "/ protect myself a bit - putting in an object would crash me ...

    (newFlags isMemberOf:SmallInteger) ifTrue:[
        flags := newFlags
    ]

    "Modified: 8.3.1996 / 13:26:05 / cg"
!

numberOfMethodArgs:aNumber
    "set the number of arguments, the method expects.
     WARNING: for internal use by the compiler only.     
              playing around here with incorrect values 
              may (will ?)  crash smalltalk badly.

     The limitation in the max. number of arguments is due to the
     missing SENDxx functions in the VM and cases in #perform. This too 
     will be removed in a later release, allowing any number of arguments.
     - for use by compiler only."

    (aNumber between:0 and:self class maxNumberOfArguments) ifFalse:[
        self error:('ST/X only supports up to a maximum of ' ,
                    self class maxNumberOfArguments printString ,
                    ' method arguments').
        ^ self
    ].
%{
    /* made this a primitive to get define in stc.h */
#ifdef F_NARGS
    __INST(flags) = __MKSMALLINT( (__intVal(__INST(flags)) & ~F_NARGS) | (__intVal(aNumber) << F_NARGSHIFT) );
#endif
%}
!

numberOfMethodVars:aNumber
    "set the number of method variables - for use by compiler only.
     WARNING: for internal use by the compiler only.     
              playing around here with incorrect values 
              may (will ?)  crash smalltalk badly."

%{  /* NOCONTEXT */
    int f = __intVal(__INST(flags));

    /* made this a primitive to get define in stc.h */
    if (__isSmallInteger(aNumber)) {
        f = (f & ~F_NVARS) | (__intVal(aNumber) << F_NVARSHIFT);
        __INST(flags) = __MKSMALLINT(f);
    }
%}
!

setResourceFlag
    "mark the method as having a <resource> definition in its
     source. 
     These resource definitions were found in ST-80 methods, and are
     currently not supported by ST/X (except for remembering this flag).
     It can be used to find resource-flagged methods quicker."

%{  /* NOCONTEXT */

#ifdef F_RESOURCE
    int f = __intVal(__INST(flags));

    f |= F_RESOURCE;
    __INST(flags) = __MKSMALLINT(f);
#endif
%}
!

stackSize:aNumber
    "set the depth of the local stack.

     WARNING: for internal use by the compiler only.
              playing around here with incorrect values 
              may crash smalltalk badly.
              (if the runtime library was compiled with DEBUG, 
               a bad stack will be detected and triggers an error)"

%{  /* NOCONTEXT */
    int f = __intVal(__INST(flags));

    /* made this a primitive to get define in stc.h */
    if (__isSmallInteger(aNumber)) {
        f = (f & ~F_NSTACK) | (__intVal(aNumber) << F_NSTACKSHIFT);
        __INST(flags) = __MKSMALLINT(f);
    }
%}
! !

!Method methodsFor:'queries'!

containingClass
    "return the class I am defined in. 
     See comment in who."

    "based on who, which has been added for ST-80 compatibility"

    |who|

    who := self who.
    who notNil ifTrue:[^ who methodClass].
    "
     none found - sorry
    "
    ^ nil

    "
     |m|
     m := Object compiledMethodAt:#at:.
     m containingClass   

     |m|
     m := Object class compiledMethodAt:#version.
     m containingClass   
    "

    "Modified: 1.11.1996 / 17:47:06 / cg"
!

hasPrimitiveCode
    "return true, if the method contains primitive code; false if not.
     Uses Parser to parse methods source and get the information."

    |src|

    src := self source.
    src notNil ifTrue:[
	(src includesString:'%{' ) ifFalse:[
	    "/ cannot contain primitive code.
	    ^ false
	]
    ].
    ^ self parse:#'parseMethodSilent:' return:#hasPrimitiveCode or:false

    "
     (Method compiledMethodAt:#hasPrimitiveCode) hasPrimitiveCode 
     (Object compiledMethodAt:#at:) hasPrimitiveCode   
     (Object compiledMethodAt:#basicAt:) hasPrimitiveCode 
    "

    "Modified: 31.10.1995 / 14:43:37 / cg"
!

hasResource
    "return true if the method had a <resource> definition in its
     source. This was found in ST-80 methods, and currently not supported
     by ST/X (except for remembering this flag).
     It can be used to find resource-flagged methods quicker."

%{  /* NOCONTEXT */

#ifdef F_RESOURCE
    RETURN (((INT)__INST(flags) & __MASKSMALLINT(F_RESOURCE)) ? true : false);
#endif
%}.
    ^ false


!

isInvalid
    "return true, if this method is not executable due to
     a (re)-compilation error. Since invalidation is by patching the
     methods code-pointer to a trap function, check for that here.
     (see comment in Method>>invalidCodeObject)."

    |m trap myCode|

    myCode := self code.

    m := self trapMethodForNumArgs:(self numArgs).
    (m notNil and:[self ~~ m]) ifTrue:[
        (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
        (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
    ].

    m := Method compiledMethodAt:#uncompiledCodeObject.
    (m notNil and:[self ~~ m]) ifTrue:[
        (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
        (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
    ].

    m := Method compiledMethodAt:#unloadedCodeObject.
    (m notNil and:[self ~~ m]) ifTrue:[
        (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
        (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
    ].

    ^ false

    "Modified: 4.11.1996 / 23:34:24 / cg"
!

isMethod
    "return true, if the receiver is some kind of method;
     true returned here - the method is redefined from Object."

    ^ true
!

methodArgAndVarNames
    "return a collection with the methods argument and variable names.
     Uses Parser to parse methods source and extract the names.
     Returns nil if the source is not available, or some other
     syntax/parse error occurred. For methods with no args and no vars,
     an empty collection is returned."

    |parser sourceString argNames varNames|

    sourceString := self source.
    sourceString notNil ifTrue:[
	parser := Parser parseMethodArgAndVarSpecificationSilent:sourceString.
	(parser isNil or:[parser == #Error]) ifTrue:[^ nil].
	argNames := parser methodArgs.
	varNames := parser methodVars.
	argNames isNil ifTrue:[^ varNames].
	varNames isNil ifTrue:[^ argNames].
	^ (argNames , varNames)
    ].
    ^ nil

    "
     (Method compiledMethodAt:#printOn:) methodArgAndVarNames
    "
!

methodArgNames
    "return a collection with the methods argument names.
     Uses Parser to parse methods source and extract the names."

    ^ self parse:#'parseMethodSpecificationSilent:' return:#methodArgs or:nil

    "
     (Method compiledMethodAt:#printOn:) methodArgNames
    "

    "Modified: 31.10.1995 / 14:36:46 / cg"
!

methodComment
    "return the methods first comment, nil if there is none.
     This is a somewhat stupid implementation."

    |text line nQuote index qIndex qIndex2 comment|

    text := self source asCollectionOfLines.
    (text size < 2) ifTrue:[^nil].

    line := (text at:2).
    nQuote := line occurrencesOf:(Character doubleQuote).
    (nQuote == 2) ifTrue:[
	qIndex := line indexOf:(Character doubleQuote).
	qIndex2 := line indexOf:(Character doubleQuote) startingAt:(qIndex + 1).
	^ line copyFrom:(qIndex + 1) to:(qIndex2 - 1)
    ].
    (nQuote == 1) ifTrue:[
	qIndex := line indexOf:(Character doubleQuote).
	comment := line copyFrom:(qIndex + 1).

	index := 3.
	line := text at:index.
	nQuote := line occurrencesOf:(Character doubleQuote).
	[nQuote ~~ 1] whileTrue:[
	    comment := comment , Character cr asString , line withoutSpaces.
	    index := index + 1.
	    line := text at:index.
	    nQuote := line occurrencesOf:(Character doubleQuote)
	].
	qIndex := line indexOf:(Character doubleQuote).
	^ comment , Character cr asString , (line copyTo:(qIndex - 1)) withoutSpaces
    ].
    ^ nil

    "
     (Method compiledMethodAt:#methodComment) methodComment
    "
!

methodVarNames
    "return a collection with the methods local-variable names.
     Uses Parser to parse methods source and extract the names."

    ^ self parse:#'parseMethodArgAndVarSpecificationSilent:' return:#methodVars or:nil

    "
     (Method compiledMethodAt:#printOn:) methodVarNames
    "

    "Modified: 31.10.1995 / 14:36:49 / cg"
!

modificationTime
    "try to extract the modificationTime as a timeStamp from
     the receivers source. If there is no source or no history line, 
     we do not know the modification time, and nil is returned."

    |s list histLine|

    HistoryManager isNil ifTrue:[^ nil].

    s := self source.
    s isNil ifTrue:[^ nil].
    list := HistoryManager getAllHistoriesFrom:s.
    list size == 0 ifTrue:[^ nil].
    histLine := list last.
    ^ AbsoluteTime 
        fromDate:histLine date 
        andTime:histLine time

    "
     (Method compiledMethodAt:#modificationTime) modificationTime
     (Method compiledMethodAt:#isMethod) modificationTime 
    "

    "Modified: 8.9.1995 / 15:08:22 / claus"
    "Modified: 4.11.1996 / 22:28:17 / cg"
!

parse:parseSelector return:accessSelector or:valueIfNoSource 
    "helper for methodArgNames, methodVarNames etc.
     Get the source, let parser parse it using parseSelector,
     return parser-info using accessSelector"

    |parser sourceString|

    sourceString := self source.
    sourceString notNil ifTrue:[
        parser := Parser perform:parseSelector with:sourceString.
        (parser isNil or:[parser == #Error]) ifTrue:[^ valueIfNoSource].
        ^ parser perform:accessSelector
    ].
    ^ valueIfNoSource

    "Modified: 12.12.1996 / 15:38:59 / cg"
!

previousVersion
    |history|

    history := Class methodHistory.
    history isNil ifTrue:[^ nil].
    ^ history at:self ifAbsent:nil

    "Modified: 7.11.1996 / 19:06:22 / cg"
!

selector
    "return the selector under which I am found in my containingClasses
     method-table. 
     See comment in who."

    "based on who, which has been added for ST-80 compatibility"

    |who|

    who := self who.
    who notNil ifTrue:[^ who methodSelector].
    "
     none found - sorry
    "
    ^ nil

    "
     |m|
     m := Object compiledMethodAt:#at:.
     m selector
    "

    "Modified: 1.11.1996 / 16:25:48 / cg"
!

who
    "return the class and selector of where I am defined in;
     nil is returned for unbound methods.

     ST/X special notice: 
        returns an instance of MethodWhoInfo, which
        responds to #methodClass and #methodSelector query messages.
        For backward- (& ST-80) compatibility, the returned object also
        responds to #at:1 and #at:2 messages.

     Implementation notice:
        Since there is no information of the containing class 
        in the method, we have to do a search here.

        Normally, this is not a problem, except when a method is
        accepted in the debugger or redefined from within a method
        (maybe done indirectly, if #doIt is done recursively)
        - the information about which class the original method was 
        defined in is lost in this case.

     Problem: 
        this is heavily called for in the debugger to create
        a readable context walkback. For unbound methods, it is
        slow, since the search (over all classes) will always fail.

     Q: should we add a backref from the method to the class 
        and/or add a subclass of Method for unbound ones ?
     Q2: if so, what about the bad guy then, who copies methods around to
         other classes ?"

    |classes cls sel|

    "
     very first, look in the class we found something the last time
     this may often give a hit, when asking who repeatingly for
     a context chain. (keep last by its name, to not keep classes from
     being garbage collected)
    "
    LastWhoClass notNil ifTrue:[
        cls := Smalltalk at:LastWhoClass ifAbsent:nil.
        cls notNil ifTrue:[
            sel := cls selectorAtMethod:self.
            sel notNil ifTrue:[
                ^ MethodWhoInfo class:cls selector:sel
"/                ^ Array with:cls with:sel
            ].

            cls := cls class.
            sel := cls selectorAtMethod:self.
            sel notNil ifTrue:[
                ^ MethodWhoInfo class:cls selector:sel
"/                ^ Array with:cls with:sel
            ].
        ]
    ].

    "
     first, limit the search to global classes only - 
     since probability is high, that the receiver is found in there ...
    "
    classes := Smalltalk allClasses.
    "
     instance methods are usually more common - search those first
    "
    classes do:[:aClass |
        |sel|

        sel := aClass selectorAtMethod:self.
        sel notNil ifTrue:[
            aClass isMeta ifTrue:[
                cls := aClass soleInstance.
                cls notNil ifTrue:[
                    LastWhoClass := cls name
                ].
            ] ifFalse:[
                LastWhoClass := aClass name.
            ].

            ^ MethodWhoInfo class:aClass selector:sel
"/            ^ Array with:aClass with:sel
        ].
    ].

    LastWhoClass := nil.
    classes do:[:aClass |
        |sel|

        sel := aClass class selectorAtMethod:self.
        sel notNil ifTrue:[ 
            aClass isMeta ifTrue:[
                cls := aClass soleInstance.
                cls notNil ifTrue:[
                    LastWhoClass := cls name
                ].
            ] ifFalse:[
                LastWhoClass := aClass name.
            ].

            ^ MethodWhoInfo class:aClass class selector:sel
"/            ^ Array with:aClass class with:sel
        ].
    ].
    "
     mhmh - must be a method of some anonymous class (i.e. one not
     in the Smalltalk dictionary). Search all instances of Behavior
    "
    Behavior allSubInstancesDo:[:someClass |
        |sel|

        sel := someClass selectorAtMethod:self.
        sel notNil ifTrue:[
            ^ MethodWhoInfo class:someClass selector:sel
"/            ^ Array with:someClass with:sel
        ]
    ].
    "
     none found - sorry
    "
    ^ nil

    "typical situation: some well-known class"
    "
     |m|
     m := Object compiledMethodAt:#copy.
     m who
    "

    "untypical situation: an anonymous class"
    "
     |m cls|

     Object 
        subclass:#FunnyClass 
        instanceVariableNames:'foo'
        classVariableNames:''
        poolDictionaries:''
        category:'testing'.
     cls := Smalltalk at:#FunnyClass.
     Smalltalk removeClass:cls.

     cls compile:'testMethod1:arg foo:=arg'.
     cls compile:'testMethod2 ^ foo'.
     m := cls compiledMethodAt:#testMethod1:.

     m who
    "

    "Modified: 1.11.1996 / 17:51:27 / cg"
!

wrapper
    "only for wrapped methods: return the wrapper.
     Thats the WrapperMethod which contains myself."

    WrappedMethod allInstancesDo:[:m |
	m originalMethod == self ifTrue:[^ m].
    ].
    ^ nil
! !

!Method methodsFor:'trap methods'!

makeInvalid
    "make the receiver an invalid method, which raises an invalidCodeObject
     signal when executed. This is not for public use - it is required for
     the objectFileLoader to invalidate methods whose code is unloaded."

    |invldMethod|

    invldMethod := self trapMethodForNumArgs:(self numArgs).
    self code:invldMethod code.
    self byteCode:nil.

    "Created: 17.9.1995 / 15:00:52 / claus"
    "Modified: 4.11.1996 / 23:04:34 / cg"
!

makeUncompiled
    "make the receiver an uncompiled method, which raises an invalidCodeObject
     signal when executed. This is not for public use - it is required for
     the compiler to invalidate methods which cannot be compiled due to errors
     after a class definition change (for example: instvars are no longer there)."

    |invldMethod|

    invldMethod := self class compiledMethodAt:#uncompiledCodeObject.
    self code:invldMethod code.
    self byteCode:nil.

    "Created: 17.9.1995 / 15:01:14 / claus"
    "Modified: 4.11.1996 / 23:04:46 / cg"
!

makeUnloaded
    "make the receiver an unloaded method, which raises an invalidCodeObject
     signal when executed. This is not for public use - it is required for
     the objectFileLoader to invalidate methods for which a shared library has
     been removed."

    |invldMethod|

    invldMethod := self class compiledMethodAt:#unloadedCodeObject.
    self code:invldMethod code.
    self byteCode:nil.

    "Created: 4.11.1996 / 22:59:21 / cg"
    "Modified: 4.11.1996 / 23:04:52 / cg"
!

trapMethodForNumArgs:numArgs
    |trapSel|

    trapSel := #(
                  #'invalidCodeObject'
                  #'invalidCodeObjectWith:'
                  #'invalidCodeObjectWith:with:'
                  #'invalidCodeObjectWith:with:with:'
                  #'invalidCodeObjectWith:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:'
                  #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:with:'
                ) at:(numArgs + 1).

    ^ Method compiledMethodAt:trapSel.

    "Created: 4.11.1996 / 21:58:58 / cg"
    "Modified: 4.11.1996 / 23:18:05 / cg"
! !

!Method::MethodWhoInfo class methodsFor:'documentation'!

documentation
"
    In earlier times, Method>>who returned an array filled
    with the methods class and selector.
    This was done, since a smalltalk method cannot return multiple
    values, but 2 values had to be returned from that method.
    Thus, the who-interface was used as:
        info := <someMethod> who.
        class := info at:1.
        sel := info at:2.

    Sure, this is ugly coding style, and the system has been changed to return
    an object (an instance of MethodWhoInfo) which responds to the two
    messages: #methodClass and #methodSelector.
    This allows to write things much more intuitive:
        info := <someMethod> who.
        class := info methodClass.
        sel := info methodSelector.

    However, to be backward compatible, the returned object still responds to
    the #at: message, but only allows inices of 1 and 2 to be used.

    The MethodWhoInfo class is private to Method - its not visible to other
    classes.
"
! !

!Method::MethodWhoInfo class methodsFor:'instance creation'!

class:cls selector:sel
    "return a new MethodWhoInfo object;
     this is a private interface for Method"

    ^ self basicNew class:cls selector:sel

    "Modified: 2.1.1997 / 15:27:59 / cg"
! !

!Method::MethodWhoInfo methodsFor:'accessing'!

methodClass
    "return the class which contains the method represented by myself"

    ^ myClass

    "
     (Method compiledMethodAt:#who) who methodClass
     (Method::MethodWhoInfo compiledMethodAt:#methodClass) who methodClass
    "

    "Modified: 2.1.1997 / 14:59:02 / cg"
!

methodSelector
    "return the selector under which the the method represented by myself
     is found in the class"

    ^ mySelector

    "Modified: 2.1.1997 / 14:59:24 / cg"
! !

!Method::MethodWhoInfo methodsFor:'compatibility'!

at:index
    "simulate the old behavior (when Method>>who returned an array)"

    index == 1 ifTrue:[
        ^ myClass
    ].
    index == 2 ifTrue:[
        ^ mySelector
    ].

    "/ sigh - full compatibility ?

    index isInteger ifFalse:[
        ^ self indexNotInteger
    ].
    ^ self subscriptBoundsError:index

! !

!Method::MethodWhoInfo methodsFor:'private accessing'!

class:cls selector:sel
    myClass := cls.
    mySelector := sel


! !

!Method class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.122 1997-01-17 23:29:39 cg Exp $'
! !
Method initialize!