"

 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.

"

Object subclass:#Method

       instanceVariableNames:'code flags byteCode literals

                              source sourcePosition category'

       classVariableNames:''

       poolDictionaries:''

       category:'Kernel-Methods'

!

Method comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

             All Rights Reserved

written spring 89 by claus

'!

!Method class methodsFor:'documentation'!

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.

    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.

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

"

! !

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

    ^ 12  "cannot be easily changed"

! !

!Method methodsFor:'accessing'!

instVarAt:index

    "redefined to catch access to code-field - it is a non-object"

    index == 1 ifTrue:[^ self code].

    ^ super instVarAt:index

!

instVarAt:index put:value

    "redefined to catch access to code-field - it is a non-object"

    index == 1 ifTrue:[^ self code:value].

    ^ super instVarAt:index put:value

!

code

    "return code field - since its a non-object return address as integer"

%{

    if (_MethodInstPtr(self)->m_code != (OBJFUNC)0) {

        RETURN ( _MKSMALLINT((int)(_MethodInstPtr(self)->m_code)) );

    }

%}.

    ^ nil

!

code:anAddress

    "set the code field - you should know what you do if doing this -

     should only be done by compiler or dynamic code loaders.

     Smalltalk can crash badly if playing around here ..."

%{

    if (_isSmallInteger(anAddress))

        _INST(code) = (OBJ)(_intVal(anAddress));

    else

        _INST(code) = nil;

%}

!

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

    line := (lines at:2).

    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.

    index := 3.

    line := text at:index.

    nQuote := line occurrencesOf:(Character doubleQuote).

    [nQuote ~~ 1] whileTrue:[

        commLines add:line.

        index := index + 1.

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

        line := text at:index.

        nQuote := line occurrencesOf:(Character doubleQuote)

    ].

    ^ commLines asString

    "(Method compiledMethodAt:#comment) comment"

!

literals

    "return the methods literal array"

    ^ literals

!

literals:anArray

    "set the methods literal array.

     WARNING: for internal use by compiler only."

    literals := anArray

!

byteCode

    "return the methods byteCode array"

    ^ byteCode

!

byteCode:aByteArray

    "set the methods byteCode array.

     WARNING: for internal use by compiler only."

    byteCode := aByteArray

!

category

    "return the methods category or nil"

    ^ category

!

category:aStringOrSymbol

    "set the methods category"

    category := aStringOrSymbol asSymbol

!

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

    ]

!

dynamic:aBoolean

    "set the flag bit stating that the machine code was created

     dynamically and should be flushed on image-restart.

     WARNING: obsolete & for internal use by the compiler only."

%{  /* NOCONTEXT */

    int f = _intVal(_INST(flags));

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

    if (aBoolean == true)

        f = f | F_DYNAMIC;

    else

        f = f & ~F_DYNAMIC;

    _INST(flags) = _MKSMALLINT(f);

%}

!

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. 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 future protection 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 cought and trigger 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]

    ].

    ^ 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 := self source asText.

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

    line := (text at:2).

    nQuote := line occurrencesOf:(Character doubleQuote).

    (nQuote == 2) ifTrue:[