"

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

	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 name:'LastFileLock'.

	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"

!

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

canvasIcon

    <resource: #image>

    ^(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 42 170 168 0 42 170 168 0 0 0 0 0 63 255 252 0 63 255 252 0 63 255 252 0 63 255 252 0 63 255 252 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]) ; colorMap:(((Array new:4) at:1 put:((Color black)); at:2 put:((Color black)); at:3 put:((Color red:68.2353 green:85.4902 blue:90.1961)); at:4 put:((Color white)); yourself)); mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 0 255 240 255 240 255 240 255 240 255 240 255 240 255 240 255 240 255 240 255 240 0 0 0 0 0 0]) ; yourself); yourself!

imageFileIcon

    <resource: #image>

    ^(Depth4Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 68 68 68 68 68 64 0 4 68 68 51 51 68 64 0 4 68 67 51 51 52 64 0 4 68 68 51 51 68 64 0 4 68 68 66 68 68 64 0 4 68 68 66 68 68 64 0 1 20 17 18 17 68 64 0 1 17 17 17 17 17 16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]) ; colorMap:((OrderedCollection new add:(Color black); add:(Color red:0.0 green:53.7255 blue:0.0); add:(Color red:52.1569 green:23.5279 blue:14.1161); add:(Color red:0.0 green:80.7828 blue:0.0); add:(Color red:68.2353 green:85.4902 blue:90.1961); add:(Color black); add:(Color white); add:(Color red:100.0 green:0.0 blue:0.0); add:(Color red:0.0 green:100.0 blue:0.0); add:(Color red:0.0 green:0.0 blue:100.0); add:(Color red:0.0 green:100.0 blue:100.0); add:(Color red:100.0 green:100.0 blue:0.0); add:(Color red:100.0 green:0.0 blue:100.0); add:(Color red:49.9977 green:0.0 blue:0.0); add:(Color red:0.0 green:49.9977 blue:0.0); add:(Color red:0.0 green:0.0 blue:49.9977); yourself)); mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 0 255 252 255 252 255 252 255 252 255 252 255 252 255 252 255 252 255 252 255 252 0 0 0 0 0 0]) ; yourself); yourself!

menuIcon

    <resource: #image>

    ^(Depth1Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 0 0 0 127 224 127 224 0 0 127 224 127 224 0 0 127 224 127 224 0 0 0 0 0 0 0 0]) ; colorMap:((OrderedCollection new add:(Color black); add:(Color white); yourself)); mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 0 255 240 255 240 255 240 255 240 255 240 255 240 255 240 255 240 255 240 255 240 0 0 0 0 0 0]) ; yourself); yourself! !

!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

    "low-level access to the source instance-variable.

     This is NOT always the methods source string"

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

!

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

"/        ]

	LastMethodSources notNil ifTrue:[

	    junk := LastMethodSources at:self ifAbsent:nil.

	    junk notNil ifTrue:[

		^ junk

	    ]

	].

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