"

 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.

"

ExecutableCodeObject subclass:#Method

       instanceVariableNames:'source sourcePosition category package'

       classVariableNames:'PrivateMethodSignal LastFileReference LastSourceFileName'

       poolDictionaries:''

       category:'Kernel-Methods'

!

Method comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	     All Rights Reserved

'!

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

"

!

version

"

"

!

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.

    The methods source-code 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.

    The flags field defines things like the number of method-locals,

    method arguments and stack size need (for interpreted methods).

    Do not depend on any value in the flags field - it may change without

    notice.

    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

					(nil if its the standard system package)

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

"

!

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.

    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 and the implementation may change (in case of some ANSI

    standard being defined) - be warned.

"

! !

!Method class methodsFor:'initialization'!

initialize

    PrivateMethodSignal isNil ifTrue:[

	ExecutableCodeObject initialize.

	"EXPERIMENTAL"

	PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.

	PrivateMethodSignal nameClass:self message:#privateMethodSignal.

	PrivateMethodSignal notifierString:'attempt to execute private/protected method'.

    ]

! !

!Method class methodsFor:'signal access'!

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:'queries'!

isBuiltInClass

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

    ^ self == Method

!

maxNumberOfArguments

    "this limit will be removed in one of the next versions ..."

    ^ 15  "cannot be easily changed"

! !

!Method methodsFor:'accessing'!

source

    "return the sourcestring for the receiver"

    |aStream fileName junk|

    source notNil ifTrue:[

	"

	 if sourcePosition is nonNil, its the fileName and

	 sourcePosition is the offset.

	 Otherwise, source is the real source

	"

	sourcePosition isNil ifTrue:[^ source].

"/

"/ original code:

"/

"/        aStream := Smalltalk systemFileStreamFor:('source/' , source).

"/        aStream notNil ifTrue:[

"/            aStream position:sourcePosition.

"/            junk := aStream nextChunk.

"/            aStream close

"/        ]

"/

"/ we keep the last source file open, because open/close

"/ operations maybe somewhat 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.

	LastSourceFileName = source ifTrue:[

	    aStream := LastFileReference at:1.

	].

	aStream isNil ifTrue:[

	    fileName := Smalltalk getSystemFileName:('source/' , source).

	    fileName isNil ifTrue:[

		fileName := source

	    ].

	    aStream := fileName asFilename readStream.

	].

	aStream notNil ifTrue:[

	    aStream position:sourcePosition.

	    junk := aStream nextChunk.

	    "

	     keep a weak reference - maybe its needed again soon ...

	    "

	    LastFileReference isNil ifTrue:[

		LastFileReference := WeakArray new:1

	    ].

	    LastFileReference at:1 put:aStream.

	    LastSourceFileName := source

	]

    ].

    ^ junk

!

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

!

sourcePosition

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

    ^ sourcePosition

!

sourceFilename:aFileName position:aNumber

    "set the methods sourcefile/position"

    source := aFileName.

    sourcePosition := aNumber

!

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 stream|

    src := self source.

    src isNil ifTrue:[^ nil].

    stream := ReadStream on:src.

    (stream skipThrough:Character doubleQuote) isNil ifTrue:[^ nil].

    ^ stream upTo:Character doubleQuote.

    "

     (Method compiledMethodAt:#comment) comment 

    "

!

category

    "return the methods category or nil"

    ^ category

!

category:aStringOrSymbol

    "set the methods category"

    category := aStringOrSymbol asSymbol

!

package

    "return the package-symbol"

    ^ package

!

flags

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

     Dont depend on the values in the flag field - it may change

     without notice."

    ^ flags

!

flags:newFlags

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

     WARNING: for internal use by the compiler only."

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

    (newFlags isMemberOf:SmallInteger) ifTrue:[

	flags := newFlags

    ]

!

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.

     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_PRIVATE

    int f = _intVal(_INST(flags));

    f = f | 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.

     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_CLASSPRIVATE

    int f = _intVal(_INST(flags));

    f = f | F_CLASSPRIVATE;

    _INST(flags) = _MKSMALLINT(f);

#endif

%}

!

setToPublic

     any send. This is the default."

%{  /* NOCONTEXT */

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

    int f = _intVal(_INST(flags));

#if F_PRIVATE

    f = f & ~F_PRIVATE;

#endif

#if F_CLASSPRIVATE

    f = f & ~F_CLASSPRIVATE;

#endif

    _INST(flags) = _MKSMALLINT(f);

%}

!

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 */

#ifdef F_PRIVATE

    int f = _intVal(_INST(flags));

    if (f & 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 */

#ifdef F_CLASSPRIVATE

    int f = _intVal(_INST(flags));

    if (f & 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."

%{  /* NOCONTEXT */

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

    int f = _intVal(_INST(flags));

#ifdef F_PRIVATE

    if (f & F_PRIVATE) {

	RETURN (false);

    }

#endif

#ifdef F_CLASSPRIVATE

    if (f & F_CLASSPRIVATE) {

	RETURN (false);

    }

#endif

%}.

    ^ true

!

numberOfMethodArgs:aNumber

    "currently, the number of arguments is NOT remembered in

     methods, but this will be added soon to allow for more checking

     in #perform:.

     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

%}

!

numberOfMethodArgs

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

%{  /* NOCONTEXT */

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

#ifdef F_NARGS

    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NARGS) >> F_NARGSHIFT));

#endif

%}

.

    "

     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:

    "

    ^ self methodArgNames size

!

numberOfMethodVars:aNumber

    "set the number of method variables - for use by compiler only.

     WARNING: playing around here with incorrect values 

	      may 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);

    }

%}

!

numberOfMethodVars

    "return the number of method local variables. 

     Do not depend on the returned value - future optimizations