Method.st
author claus
Thu, 02 Jun 1994 18:22:49 +0200
changeset 88 81dacba7a63a
parent 85 1343af456e28
child 93 e31220cb391f
permissions -rw-r--r--
*** empty log message ***

"
 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'
       classVariableNames:''
       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
"
$Header: /cvs/stx/stx/libbasic/Method.st,v 1.15 1994-06-02 16:20:56 claus Exp $
"
!

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.

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

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

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

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]
    ].
    "
     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 := self source asText.
    (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"
!

referencesGlobal:aGlobalSymbol
    "return true, if this method references the global
     bound to aGlobalSymbol."

    literals isNil ifTrue:[^ false].
    ^ (literals identityIndexOf:aGlobalSymbol startingAt:1) ~~ 0
!

sends:aSelectorSymbol
    "return true, if this method contains a message-send
     with aSelectorSymbol as selector. 
     - due to the simple check in the literal array, also simple uses 
       of aSelectorSymbol as symbol will return true.
       Should ask compiler, if there is really a send."

    ^ self referencesGlobal:aSelectorSymbol
!

isWrapped
    ^ false
! !

!Method methodsFor:'error handling'!

invalidMethod
    "this error is triggered by the interpreter when a nil or non method
     about to be executed.
     Also, the Compiler creates invalid methods when, after a class change
     some methods are no longer executable (for example, after an instvar
     has been removed, and a method still tries to access this instvar)

     In this case, the VM sends this to the bad method (the receiver).

     Can only happen, when playing around in a classes methodArray,
     or compiler/runtime system is broken, or you ignore the error messages
     during some recompile."

    self error:'invalid method - not executable'
!

tooManySendArguments
    "this error is triggered, when a method tries to perform a send with
     more arguments than supported by the interpreter. This can only happen, 
     if the compiler has been changed without updating the VM."

    self error:'too many send args - should not happen'
!

tooManyArguments
    "this error is triggered, when a method is called with more arguments
     than supported by the interpreter. This can only happen, if the 
     compiler has been changed without updating the VM."

    self error:'method has too many args - should not happen'
! !

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

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

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

    if (__isArray(argArray)) {
        nargs = _arraySize(argArray);
        ap = _ArrayInstPtr(argArray)->a_element;
    } else {
        if (argArray == nil) {
            nargs = 0;
        } else
            nargs = -1;
    }

    code = _MethodInstPtr(self)->m_code;
    if (aClass == nil) {
        searchClass = dummy.ilc_class = _Class(anObject);
    } else {
        searchClass = dummy.ilc_class = aClass;
    }

    if (code) {
        /* compiled code */
        switch (nargs) {
            case 0:
                RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy) );

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

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

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

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

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

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

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

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

            case 9:
                RETURN ( (*code)(anObject, aSymbol, SND_COMMA 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, SND_COMMA 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, SND_COMMA 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, SND_COMMA 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, SND_COMMA 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, SND_COMMA 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, SND_COMMA 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 */
        switch (nargs) {
            case 0:
                RETURN ( interpret(self, 0, anObject, aSymbol, SND_COMMA searchClass) );

            case 1:
                RETURN ( interpret(self, 1, anObject, aSymbol, SND_COMMA searchClass,
                                   ap[0]) );

            case 2:
                RETURN ( interpret(self, 2, anObject, aSymbol, SND_COMMA searchClass,
                                   ap[0], ap[1]) );

            case 3:
                RETURN ( interpret(self, 3, anObject, aSymbol, SND_COMMA searchClass,
                                   ap[0], ap[1], ap[2]) );

            case 4:
                RETURN ( interpret(self, 4, anObject, aSymbol, SND_COMMA searchClass,
                                   ap[0], ap[1], ap[2], ap[3]) );

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

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

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

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

            case 9:
                RETURN ( interpret(self, 9, anObject, aSymbol, SND_COMMA searchClass,
                                   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, SND_COMMA searchClass,
                                   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, SND_COMMA searchClass,
                                   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, SND_COMMA searchClass,
                                   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, SND_COMMA searchClass,
                                   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, SND_COMMA searchClass,
                                   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, SND_COMMA searchClass,
                                   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]) );
        }
    }
%}
.
    (argArray isMemberOf:Array) ifFalse:[
        ^ self error:'argumentArray must be an Array'
    ].
    ^ self error:'too many arguments'

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

!Method methodsFor:'printing'!

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

    |myClass|

    aStream nextPutAll:'a Method('.
    myClass := self containingClass.
    myClass notNil ifTrue:[
        myClass name printOn:aStream.
        aStream nextPutAll:' '.
        (myClass selectorForMethod:self) printOn:aStream
    ] ifFalse:[
        aStream nextPutAll:'???'
    ].
    aStream nextPut:$)
! !

!Method methodsFor:'binary storage'!

asByteCodeMethod
    "if the receiver has no bytecodes, create a method having
     the same semantic 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.
     Can be used to obtain a bytecode version of a method for binary storage
     or dynamic recompilation (which is not yet finished)."

    |temporaryMethod cls sourceString upd silent|

    byteCode notNil ifTrue:[^ self].

    cls := self containingClass.
    sourceString := self source.
    sourceString notNil ifTrue:[
        upd := Class updateChanges:false.
        silent := Smalltalk silentLoading:true.
        [
            temporaryMethod := cls compiler compile:sourceString
                                           forClass:cls
                                         inCategory:(self category)
                                          notifying:nil
                                            install:false.
        ] valueNowOrOnUnwindDo:[
            Class updateChanges:upd.
            Smalltalk silentLoading:silent.
        ].
        (temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
            'cannot generate bytecode (contains primitive code or error)' errorPrintNewline.
            ^ nil
        ].
        "
         try to save a bit of memory, by sharing the source (whatever it is)
        "
        temporaryMethod sourceFileName:source position:sourcePosition. 

        ^ temporaryMethod
    ].
    'cannot generate bytecode (no source for compilation)' errorPrintNewline.
    ^ nil

    "
     (LargeInteger compiledMethodAt:#normalize) asByteCodeMethod
     (SmallInteger compiledMethodAt:#+) asByteCodeMethod  
    "
!

storeBinaryDefinitionOn: stream manager: manager
    "can only store bytecode - machine code is not storable.
     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|

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

!Method methodsFor:'obsolete binary fileOut'!

binaryFileOutLiteralsOn:aStream
    |index n|

    literals isNil ifTrue:[
        aStream nextPutAll:'0'.
        aStream nextPut:$!!.
        ^ self
    ].
    aStream nextPutAll:literals size printString.
    aStream nextPut:$!!.

    index := 1.
    literals do:[:lit |
        lit isNumber ifTrue:[
            lit storeOn:aStream
        ] ifFalse:[
            ((lit isKindOf:String) or:[lit isKindOf:Character]) ifTrue:[
                lit storeOn:aStream
            ] ifFalse:[
                (lit isKindOf:Array) ifTrue:[
                    aStream nextPut:$(.
                    lit storeOn:aStream.
                    aStream nextPut:$)
                ] ifFalse:[
                    lit isBehavior ifTrue:[
                        aStream nextPutAll:'(Smalltalk at:#'.
                        n := lit name.
                        lit isMeta ifTrue:[
                            n := (n copyTo:(n size - 5)) , ') class'
                        ] ifFalse:[
                            n := n , ')'
                        ].
                        aStream nextPutAll:n
                    ] ifFalse:[
                        self error:('invalid literal ' , lit class name)
                    ]
                ]
            ]
        ].
        aStream nextPut:$!!.
        index := index + 1
    ]
!

binaryFileOutOn:aStream
    byteCode isNil ifTrue:[
        self notify:'no bytecodes to fileout'.
        ^ self
    ].
    self binaryFileOutLiteralsOn:aStream.

    flags storeOn:aStream.
    aStream nextPut:$!!.

    byteCode size storeOn:aStream.
    aStream nextPut:$!!.
    aStream nextPutBytes:(byteCode size) from:byteCode
! !