"

 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'

       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

"

! !

!Method class methodsFor:'initialization'!

initialize

    PrivateMethodSignal isNil ifTrue:[

        "EXPERIMENTAL"

        PrivateMethodSignal := (Signal new) mayProceed:true.

        PrivateMethodSignal notifierString:'attempt to execute private method'.

    ]

! !

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

    source notNil ifTrue:[

        sourcePosition isNil ifTrue:[^ source].

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

        aStream notNil ifTrue:[

            aStream position:sourcePosition.

            junk := aStream nextChunk.

            aStream close

        ]

    ].

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

     Returns nil if there is no comment (or source is not available)."

    |text lines line nQuote index i1 i2 commLines|

    text := self source.

    text isNil ifTrue:[^ nil].

    lines := text asCollectionOfLines.

    (lines size < 2) ifTrue:[^ nil].

    index := 2.

    "

     skip empty lines

    "

    line := (lines at:index).

    [line isBlank] whileTrue:[

        index := index + 1.

        index > lines size ifTrue:[^ nil].

        line := (lines at:index).

    ].

    nQuote := line occurrencesOf:(Character doubleQuote).

    (nQuote == 0) ifTrue:[^ nil].

    (nQuote == 2) ifTrue:[^ line].

    (nQuote > 2) ifTrue:[

        i1 := line indexOf:(Character doubleQuote).

        i2 := line indexOf:(Character doubleQuote) startingAt:(i1 + 1).

        ^ line copyFrom:i1+1 to:i2-1

    ].

    commLines := Text new.

    commLines add:line.

    [nQuote ~~ 1] whileTrue:[

        index := index + 1.

        index > lines size ifTrue:[^ nil]. "unclosed comment - could warn here"

        line := lines at:index.

        nQuote := line occurrencesOf:(Character doubleQuote).

        commLines add:line.

    ].

    ^ commLines asString

    "

     (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

    ]

!

private:aBoolean

    "set the flag bit stating that this method is private, and should only be

     allowed for self-sends from the class or self/super sends from subclasses.

     EXPERIMENTAL."

%{  /* NOCONTEXT */

    int f = _intVal(_INST(flags));

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

#ifdef F_PRIVATE

    if (aBoolean == true)

        f = f | F_PRIVATE;

    else

        f = f & ~F_PRIVATE;

    _INST(flags) = _MKSMALLINT(f);

#endif

%}

!

isPrivate

    "return true, if this is a private method (i.e. on which is allowed

     for self-sends from the classes methods or self/super sends from subclasses

     methods only.

     EXPERIMENTAL."

%{  /* NOCONTEXT */

    int f = _intVal(_INST(flags));

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

#ifdef F_PRIVATE

    if (f & F_PRIVATE) {

        RETURN (true);

    }

#endif

%}.

    ^ false

!

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

     may change things here (i.e. when moving block-locals into

     surrounding method for inlining).

     - for debugging only."

%{  /* NOCONTEXT */

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

    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NVARS) >> F_NVARSHIFT));

%}

!

stackSize:aNumber

    "set the depth of the local stack - for use by compiler only.

     WARNING: 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);

    }

%}

!

stackSize

    "return the number of temporaries needed as stack in the context. 

     Do not depend on the returned value - future optimizations

     may change things here.

     - for debugging only."

%{  /* NOCONTEXT */

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

    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NSTACK) >> F_NSTACKSHIFT));

%}

! !

!Method methodsFor:'queries'!

containingClass

    "return the class I am defined in. 

     Since there is no information of the containing class 

     in the method, we have to search here.

     Normally, this is not a problem, except when a method is

     accepted in the debugger - the information about which

     class the original method was in is then lost.

     Q: should we add a backref from the method to the class ?"

    Smalltalk allBehaviorsDo:[:aClass |

        (aClass containsMethod:self) ifTrue:[^ aClass].

        (aClass class containsMethod:self) ifTrue:[^ aClass class]

    ].

    "

     mhmh - must be a method of some anonymous class (i.e. one not

     in the Smalltalk dictionary; search all instances of Behavior

    "

    Behavior allDerivedInstancesDo:[:someClass |

        (someClass containsMethod:self) ifTrue:[

            ^ someClass

        ].

    ].

    "

     none found - sorry

    "

    ^ nil

!

methodArgNames

    "return a collection with the methods argument names.

     Uses Parser to parse methods source and extract the names."

    |parser sourceString|

    sourceString := self source.

    sourceString notNil ifTrue:[

        parser := Parser parseMethodSpecification:sourceString.

        (parser isNil or:[parser == #Error]) ifTrue:[^ nil].

        ^ parser methodArgs

    ].

    ^ nil

    "

     (Method compiledMethodAt:#printOn:) methodArgNames

    "

!

methodVarNames

    "return a collection with the methods local-variable names.

     Uses Parser to parse methods source and extract the names."

    |parser sourceString|

    sourceString := self source.

    sourceString notNil ifTrue:[

        parser := Parser parseMethodArgAndVarSpecification:sourceString.

        (parser isNil or:[parser == #Error]) ifTrue:[^ nil].

        ^ parser methodVars

    ].

    ^ nil

    "

     (Method compiledMethodAt:#printOn:) methodVarNames

    "

!

methodArgAndVarNames

    "return a collection with the methods argument and variable names.

     Uses Parser to parse methods source and extract the names."

    |parser sourceString argNames varNames|

    sourceString := self source.

    sourceString notNil ifTrue:[

        parser := Parser parseMethodArgAndVarSpecification: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

    "

!

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