"

 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.

"

"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

CompiledCode variableSubclass:#Method

	instanceVariableNames:'source sourcePosition category package mclass lookupObject

		annotations'

	classVariableNames:'PrivateMethodSignal LastFileReference LastSourceFileName

		LastWhoClass LastFileLock LastMethodSources LastMethodSourcesLock

		CompilationLock Overrides LastParseTreeCache'

	poolDictionaries:''

	category:'Kernel-Methods'

!

Object subclass:#MethodWhoInfo

	instanceVariableNames:'myClass mySelector'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Method

!

Object subclass:#ParseTreeCacheEntry

	instanceVariableNames:'parserClass method parser'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Method

!

Object subclass:#ParserCacheEntry

	instanceVariableNames:'parserClass method parser'

	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.

    (or, a user defined interpreter can be invoked on the smalltalk level)

    The method's 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 fields holds the source string.

    (an old version used ExternalString instances here, but that lead to

     10000's of 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 an instance 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

	mclass          <Class>         the class in which I am defined

	indexed slots                   literals

    [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 stc-compiled 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.

    Notice: this has nothing to do with JIT compilation, which is always possible.

    JIT-compilation is done from bytecodes to a machineCode cache.

    In contrast, dynamic loading of stc-compiled code goes via intermediate C-code

    which is compiled by the machines native C-compiler.

    As opposed to JITted code, this allows for embedded primitive C-code.

"

!

privacy

"

    ST/X includes an EXPERIMENTAL implementation of method privacy.

    Individual methods may be set to private or protected via the

    privacy:#private and privacy:#protected 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).

    Protected methods may be executed only when called via a self-send

    from the superclass-methods and self or super-sends from methods in the

    class itself or subclasses.

    Private methods may not be called from subclasses-methods,

    i.e. they may only be called via self sends from within the current class.

    (i.e. protected methods are less private than private 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 definition protocol 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 ;-)

    Late note (Feb 2000):

	the privacy feature has new been in ST/X for some years and was NOT heavily

	used - neither at eXept, nor by customers.

	In Smalltalk, it seems to be a very questionable feature, actually limiting

	code reusability.

	The privacy features are left in the system to demonstrate that it can be

	done in Smalltalk (for religious C++ fans ... to avoid useless discussions)

	(the check is not expensive, w.r.t. the VM runtime behavior).

"

! !

!Method class methodsFor:'initialization'!

initialize

    "create signals"

    PrivateMethodSignal isNil ifTrue:[

	"EXPERIMENTAL"

	PrivateMethodSignal := ExecutionError newSignalMayProceed:true.

	PrivateMethodSignal nameClass:self message:#privateMethodSignal.

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

    ].

    LastFileLock isNil ifTrue:[

	LastFileLock := RecursionLock new name:'Method-LastFile'.

	LastMethodSourcesLock := RecursionLock new name:'Method-LastMethodSources'.

	LastFileReference := WeakArray new:1.

	LastFileReference at:1 put:nil.

    ].

    CompilationLock := RecursionLock new name:'MethodCompilation'.

    "Modified: / 03-01-1997 / 16:58:16 / stefan"

    "Modified (comment): / 20-07-2012 / 18:41:11 / cg"

!

lastMethodSourcesLock

    LastMethodSourcesLock isNil ifTrue:[

	self initialize

    ].

    ^ LastMethodSourcesLock

! !

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

lowSpaceCleanup

    LastParseTreeCache := nil.

    LastSourceFileName := LastWhoClass := nil.

    self flushSourceStreamCache.

    "Created: / 08-08-2011 / 19:11:23 / cg"

! !

!Method class methodsFor:'queries'!

binarySelectorCharacters

    "return a collection of characters which are allowed in binary selectors"

    ^ '&-+=*/\<>~@,?!!|%#'.

!

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"

!

maxBinarySelectorSize

    ^ 3

    "

     in ST/X, binops are allowed with up-to 3 characters;

     for example:

	<->

	<=>

	+++

	:=:

     etc. are valid binOps here

    "

!

methodDefinitionTemplateForSelector:aSelector

    "given a selector, return a prototype definition string"

    ^ self programmingLanguage

	methodDefinitionTemplateForSelector:aSelector

    "

     Method methodDefinitionTemplateForSelector:#foo

     Method methodDefinitionTemplateForSelector:#+

     Method methodDefinitionTemplateForSelector:#foo:bar:baz:

    "

!

methodDefinitionTemplateForSelector:aSelector andArgumentNames:argNames

    "given a selector, return a prototype definition string"

    ^ self programmingLanguage

	methodDefinitionTemplateForSelector:aSelector andArgumentNames:argNames

    "

     Method methodDefinitionTemplateForSelector:#foo          andArgumentNames:#()

     Method methodDefinitionTemplateForSelector:#+            andArgumentNames:#('aNumber')

     Method methodDefinitionTemplateForSelector:#foo:bar:baz: andArgumentNames:#('fooArg' 'barArg' 'bazArg')

    "

!

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

%}

!

resourceTypes

    "get the types of resources for which a spec definition and corresponding editor exist"

    ^ #(canvas menu image fileImage help hierarchicalList tabList tableColumns)

! !

!Method class methodsFor:'special'!

flushParseTreeCache

    "used by lint and the compiler"

    LastParseTreeCache := nil

    "

     Method flushParseTreeCache

    "

    "Created: / 01-03-2012 / 16:45:34 / cg"

!

flushSourceStreamCache

    LastFileLock critical:[

	LastSourceFileName := LastMethodSources := nil.

	LastFileReference at:1 put:0.

    ].

    "

     Method flushSourceStreamCache

    "

    "Created: 9.2.1996 / 19:05:28 / cg"

! !

!Method class methodsFor:'trap methods'!

trapMethodForNumArgs:numArgs

    "return a method which will raise an invalid code object exception.

     Before recompiling methods (due to changed variable scopes, for example),

     all method's code is replaced by this. If recompilation fails, this code

     remains in the method to make it trap, whenever executed later.

     Otherwise, if recompilation succeeeds, that code will vanish after the compile"

    |trapSel trapMethod|

    trapSel := #(

		   invalidCodeObject

		   invalidCodeObjectWith:

		   invalidCodeObjectWith:with:

		   invalidCodeObjectWith:with:with:

		   invalidCodeObjectWith:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:

		   invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:with:

		) at:(numArgs + 1).

    (trapMethod := self compiledMethodAt:trapSel) isNil ifTrue:[

	trapMethod := Method compiledMethodAt:trapSel.

    ].

    ^ trapMethod.

    "

	self trapMethodForNumArgs:2

    "

    "Created: / 04-11-1996 / 21:58:58 / cg"

    "Modified: / 14-09-2011 / 11:23:09 / sr"

    "Modified (comment): / 30-10-2011 / 11:04:24 / cg"

! !

!Method methodsFor:'Compatibility-Squeak'!

isCompiledMethod

    ^ true

    "Created: / 13-06-2012 / 14:51:19 / cg"

!

pragmaAt:aKey

    ^ self annotationAt:aKey

    "Created: / 11-09-2011 / 18:09:05 / cg"

!

pragmas

    "for squeak compatibility, we only present real pragmas"

    ^ (self annotations ? #()) select:[:a | a isArray not and:[ a isResource not ] ]

!

propertyValueAt:aKey

    "for now - no properties"

    ^ nil

    "Created: / 12-09-2011 / 08:42:02 / cg"

!

sourceCode

    ^ self source

    "Created: / 30-10-2014 / 23:24:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Method methodsFor:'Compatibility-VW'!

attributeAt:aSymbol ifAbsent:exceptionValue

    |annots|

    annots := self annotationsAt:aSymbol.

    annots isEmptyOrNil ifTrue:[

	(aSymbol endsWith:$:) ifFalse:[

	    annots := self annotationsAt:(aSymbol,$:) asSymbol.

	].

	annots isEmptyOrNil ifTrue:[

	    ^ exceptionValue value

	].

    ].

    ^ annots first arguments first

!

attributeMessages

    ^ self annotations

	collect:[:annot | Message selector:annot key arguments:annot arguments]

!

classIsMeta

    "return true, if this method is a class method"

    ^ self mclass isMeta

!

sendsAnySelector:aCollectionOfSymbols

    "return true, if this method contains a message-send

     with any from aCollectionOfSymbols as selector."

    ^ self sendsAny:aCollectionOfSymbols

!

sendsSelector:aSelectorSymbol

    "return true, if this method contains a message-send

     with aSelectorSymbol as selector."

    ^ self sends:aSelectorSymbol

! !

!Method methodsFor:'accessing'!

category

    "return the methods category or nil"

    ^ category

!

category:aStringOrSymbol

    "set the methods category"

    |newCategory oldCategory cls|

    aStringOrSymbol notNil ifTrue:[

	newCategory := aStringOrSymbol.

	newCategory ~= (oldCategory := category) ifTrue:[

	    self setCategory:newCategory.

	    cls := self mclass.

	    cls notNil ifTrue:[

		cls addChangeRecordForMethodCategory:self category:newCategory.

		self changed:#category with:oldCategory.            "/ will vanish

		cls changed:#organization with:self selector.       "/ will vanish

		Smalltalk changed:#methodCategory with:(Array with:cls with:self with:oldCategory).

	    ]