"
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'
poolDictionaries:''
category:'Kernel-Methods'
!
!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
"
!
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
PrivateMethodSignal isNil ifTrue:[
"EXPERIMENTAL"
PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.
PrivateMethodSignal nameClass:self message:#privateMethodSignal.
PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
]
! !
!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.
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"
! !
!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; should ask the VM about this number"
!
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:'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 stream|
src := self source.
src isNil ifTrue:[^ nil].
stream := ReadStream on:src.
(stream skipThrough:Character doubleQuote) isNil ifTrue:[^ nil].
^ stream upTo:Character doubleQuote.
"
(Method compiledMethodAt:#comment) comment
"
!
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
]
!
getSource
^ source
!
isIgnored
"return true, if this is an ignored method.
Ignored methods are physically present in the source file,
but no code is generated for it by stc, and the VM does not see
it in its message lookup.
(i.e. setting a method to #ignored, and sending that selector,
leads to either the superclasses implementation to be called,
or a doesNotUnderstand exception to be raised)
Notice: this is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
#if defined(F_IGNORED) && defined(M_PRIVACY)
int f = _intVal(_INST(flags));
if ((f & M_PRIVACY) == F_IGNORED) {
RETURN (true);
}
#endif
%}.
^ false
!
isPrivate
"return true, if this is a private method.
Execution of private methods is only allowed via self/super sends
from superclasses, the class itself or subclasses.
If a private method is called by some other class, a runtime
error (PrivateMethodSignal) is raised.
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
#if defined(F_PRIVATE) && defined(M_PRIVACY)
int f = _intVal(_INST(flags));
if ((f & M_PRIVACY) == F_PRIVATE) {
RETURN (true);
}
#endif
%}.
^ false
!
isProtected
"return true, if this is a protected method.
Execution of protected methods is only allowed via self sends
from superclasses or the class itself.
If a protected method is called by some other class, a runtime
error (PrivateMethodSignal) is raised.
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
#if defined(F_CLASSPRIVATE) && defined(M_PRIVACY)
int f = _intVal(_INST(flags));
if ((f & M_PRIVACY) == F_CLASSPRIVATE) {
RETURN (true);
}
#endif
%}.
^ false
!
isPublic
"return true, if this is a public method - I.e. can be executed via any send.
This is the default and how other smalltalk implementations treat all methods.
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
#if defined(M_PRIVACY) && (defined(F_PRIVATE) || defined(F_CLASSPRIVATE) || defined(F_IGNORED))
int f = _intVal(_INST(flags));
# ifdef F_PRIVATE
if ((f & M_PRIVACY) == F_PRIVATE) {
RETURN (false);
}
# endif
# ifdef F_CLASSPRIVATE
if ((f & M_PRIVACY) == F_CLASSPRIVATE) {
RETURN (false);
}
# endif
# ifdef F_IGNORED
if ((f & M_PRIVACY) == F_IGNORED) {
RETURN (false);
}
# endif
#endif
%}.
^ true
!
isRestricted
"return the flag bit stating that this method is restricted.
Execution of the receiver will only be allowed if the system is not in
'trap restricted mode' (-->ObjectMemory) otherise a runtime
error (PrivateMethodSignal) is raised.
Notice: method restriction is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
#ifdef F_RESTRICTED
int f = _intVal(_INST(flags));
if (f & F_RESTRICTED) {
RETURN (true);
}
#endif
%}.
^ false
!
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
!
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
%}
!
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));
%}
!
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);
}
%}
!
package
"return the package-symbol"
^ package
!
package:aSymbol
"set the package-symbol"
package := aSymbol
!
privacy
"return a symbol describing the methods access rights (privacy);
Currently, this is one of #private, #protected, #public or #ignored.
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
If at all, use it for debugging purposes, to catch messagesends
which are not supposed to be sent by others.
(especially, if working in a team, while integrating other peoples work)
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
self isPrivate ifTrue:[^ #private].
self isProtected ifTrue:[^ #protected].
self isIgnored ifTrue:[^ #ignored].
^ #public
"Modified: 27.8.1995 / 22:53:31 / claus"
!
privacy:aSymbol
"set the methods access rights (privacy) from a symbol;
Currently, this must be one of #private, #protected, #public or #ignored.
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
If at all, use it for debugging purposes, to catch messagesends
which are not supposed to be sent by others.
(especially, if working in a team, while integrating other peoples work)
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
aSymbol == #public ifTrue:[
"/
"/ no need to flush, if changing from private to public
"/
self isIgnored ifFalse:[
^ self setToPublic
].
self setToPublic
] ifFalse:[
aSymbol == #private ifTrue:[
self setToPrivate
] ifFalse:[
aSymbol == #protected ifTrue:[
self setToProtected
] ifFalse:[
aSymbol == #ignored ifTrue:[
self setToIgnored
]
]
]
].
ObjectMemory flushCaches.
"Modified: 27.8.1995 / 22:58:08 / claus"
!
restricted:aBoolean
"set or clear the flag bit stating that this method is restricted.
Execution of the receiver will only be allowed if the system is not in
'trap restricted mode' (-->ObjectMemory) otherise a runtime
error (PrivateMethodSignal) is raised.
Notice: method restriction is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
#ifdef F_RESTRICTED
int f = _intVal(_INST(flags));
int old;
old = f;
if (aBoolean == true)
f |= F_RESTRICTED;
else
f &= ~F_RESTRICTED;
_INST(flags) = _MKSMALLINT(f);
if (old & F_RESTRICTED)
RETURN(true);
#endif
%}.
^ false
"
(ObjectMemory class compiledMethodAt:#compressingGarbageCollect) restricted:true
"
"Created: 7.11.1995 / 20:36:19 / stefan"
!
setToIgnored
"make this method be ignored w.r.t. method lookup.
(i.e. setting a method to #ignored, and sending that selector,
leads to either the superclasses implementation to be called,
or a doesNotUnderstand exception to be raised)
Notice: ignored methods are a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
int f = _intVal(_INST(flags));
#if defined(F_IGNORED) && defined(M_PRIVACY)
f = (f & ~M_PRIVACY) | F_IGNORED;
#endif
_INST(flags) = _MKSMALLINT(f);
%}
!
setToPrivate
"set the flag bit stating that this method is private.
Execution of the receiver will only be allowed for self/super-sends from
the class, superclasses or subclasses (or via #perform).
If a private method is called by some other class, a runtime
error (PrivateMethodSignal) is raised.
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
If at all, use it for debugging purposes, to catch messagesends
which are not supposed to be sent by others.
(especially, if working in a team, while integrating other peoples work)
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
#if defined(F_PRIVATE) && defined(M_PRIVACY)
int f = _intVal(_INST(flags));
f = (f & ~M_PRIVACY) | F_PRIVATE;
_INST(flags) = _MKSMALLINT(f);
#endif
%}
!
setToProtected
"set the flag bit stating that this method is protected.
Execution of the receiver will only be allowed for self sends from
the class or superclasses. (or via #perform).
If a private method is called by some other class, a runtime
error (PrivateMethodSignal) is raised.
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
If at all, use it for debugging purposes, to catch messagesends
which are not supposed to be sent by others.
(especially, if working in a team, while integrating other peoples work)
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
#if defined(F_CLASSPRIVATE) && defined(M_PRIVACY)
int f = _intVal(_INST(flags));
f = (f & ~M_PRIVACY) | F_CLASSPRIVATE;
_INST(flags) = _MKSMALLINT(f);
#endif
%}
!
setToPublic
"clear any privacy/ignoreFlag of the receiver.
The receiver may be executed by any send.
This is the default anyway for methods, and how other smalltalk
implementations treat all methods.
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
If at all, use it for debugging purposes, to catch messagesends
which are not supposed to be sent by others.
(especially, if working in a team, while integrating other peoples work)
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
#ifdef M_PRIVACY
int f = _intVal(_INST(flags));
f = f & ~M_PRIVACY;
_INST(flags) = _MKSMALLINT(f);
#endif
%}
!
source
"return the sourcestring for the receiver"
|aStream fileName junk w myClass mgr className|
"
if sourcePosition is nonNil, its the fileName and
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
"/ ]
"/ 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.
LastSourceFileName = source ifTrue:[
aStream := LastFileReference at:1.
].
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)
"/
w := self who.
w notNil ifTrue:[
myClass := w at:1.
aStream := myClass sourceStreamFor:source.
].
aStream isNil ifTrue:[
"/
"/ nope - look in standard places
"/ (if there is a source-code manager - otherwise, we already did that)
"/
mgr notNil ifTrue:[
fileName := Smalltalk getSourceFileName:source.
fileName notNil ifTrue:[
aStream := fileName asFilename readStream.
]
].
"/
"/ final chance: try current directory
"/
aStream isNil ifTrue:[
aStream := source asFilename readStream.
]
].
(aStream isNil and:[w isNil and:[source notNil]]) ifTrue:[
"/
"/ mhmh - seems to be a method which used to be in some
"/ class, but has been overwritten by another or removed.
"/ (i.e. it has no containing class anyMore)
"/ try to guess the class from the sourceFileName.
"/ and retry.
"/
className := Smalltalk classNameForFile:source.
className knownAsSymbol ifTrue:[
myClass := Smalltalk at:className asSymbol ifAbsent:nil.
myClass notNil ifTrue:[
aStream := myClass sourceStreamFor:source.
]
]
]
]
].
aStream notNil ifTrue:[
aStream position:sourcePosition.
junk := aStream nextChunk.
"
keep a weak reference - it may be needed again soon ...
"
LastFileReference isNil ifTrue:[
LastFileReference := WeakArray new:1
].
LastFileReference at:1 put:aStream.
LastSourceFileName := source
]
].
^ junk
"Modified: 9.2.1996 / 19:09:18 / cg"
!
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
!
sourceFilename:aFileName position:aNumber
"set the methods sourcefile/position"
source := aFileName.
sourcePosition := aNumber
!
sourcePosition
"return the sourceposition if source is extern; nil otherwise"
^ sourcePosition
!
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));
%}
!
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);
}
%}
! !
!Method methodsFor:'binary storage'!
asByteCodeMethod
"if the receiver has no bytecodes, create & return a method having
the same semantics 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 machine-code method,
for binary storage or dynamic recompilation (which is not yet finished)
or to compile lazy methods down to executable ones."
|doMachineCode mthd|
byteCode notNil ifTrue:[
"
is already a bytecoded method
"
^ self
].
doMachineCode := Compiler stcCompilation:#never.
[
mthd := self asExecutableMethod.
] valueNowOrOnUnwindDo:[
Compiler stcCompilation:doMachineCode.
].
^ mthd
"Created: 24.10.1995 / 14:02:32 / cg"
"Modified: 24.10.1995 / 14:17:21 / cg"
!
asExecutableMethod
"if the receiver has neither bytecodes nor machinecode, create & return a
method having semantics as the receivers source. This may be machine code,
if the system supports dynamic loading of object code and the source includes
primitive code. However, bytecode is preferred, since it compiles faster.
Otherwise, return the receiver. The new method is not installed in
the methodDictionary of any class - just returned.
Can be used to compile lazy methods down to executable ones."
|temporaryMethod cls sourceString silent lazy|
byteCode notNil ifTrue:[
"
is already a bytecoded method
"
^ self
].
cls := self containingClass.
cls isNil ifTrue:[
'METHOD: cannot generate bytecode (no class for compilation)' errorPrintNL.
^ nil
].
sourceString := self source.
sourceString isNil ifTrue:[
'METHOD: cannot generate bytecode (no source for compilation)' errorPrintNL.
^ nil
].
"
dont want this to go into the changes file,
dont want output on Transcript and definitely
dont want a lazy method ...
"
Class withoutUpdatingChangesDo:[
silent := Smalltalk silentLoading:true.
lazy := Compiler compileLazy:false.
[
|compiler|
compiler := cls compilerClass.
"/
"/ kludge - have to make ST/X's compiler protocol
"/ be compatible to ST-80's
"/
(compiler respondsTo:#compile:forClass:inCategory:notifying:install:skipIfSame:)
ifTrue:[
temporaryMethod := compiler
compile:sourceString
forClass:cls
inCategory:(self category)
notifying:nil
install:false.
] ifFalse:[
temporaryMethod := compiler new
compile:sourceString
in:cls
notifying:nil
ifFail:nil
].
] valueNowOrOnUnwindDo:[
Compiler compileLazy:lazy.
Smalltalk silentLoading:silent.
]
].
(temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
'METHOD: cannot generate bytecode (contains primitive code or error)' errorPrintNL.
^ nil.
].
"
try to save a bit of memory, by sharing the source (whatever it is)
"
temporaryMethod sourceFilename:source position:sourcePosition.
^ temporaryMethod
"Created: 24.10.1995 / 14:02:30 / cg"
"Modified: 7.3.1996 / 19:19:12 / cg"
!
readBinaryContentsFrom: stream manager: manager
"tell the newly restored Font about restoration"
self code notNil ifTrue:[
"built-in method - already complete"
^ self
].
^ super readBinaryContentsFrom: stream manager: manager
!
storeBinaryDefinitionOn:stream manager:manager
"only store bytecode-methods - machinecode methods are stored
as class/selector pair and a lookup is done when restored.
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 who|
byteCode isNil ifTrue:[
self code notNil ifTrue:[
(who := self who) notNil ifTrue:[
"
machine code only - assume its a built-in method,
and store the class/selector information.
The restored method may not be exactly the same ...
"
manager putIdOfClass:(self class) on:stream.
stream nextPutByte:0. "means: built-in method"
manager putIdOf:(who at:1) on:stream.
manager putIdOf:(who at:2) on:stream.
^ self
]
].
storedMethod := self asByteCodeMethod.
storedMethod isNil ifTrue:[
self error:'store of built-in method failed'.
^ nil
].
^ storedMethod storeBinaryDefinitionOn:stream manager:manager
].
manager putIdOfClass:(self class) on:stream.
stream nextPutByte:1. "means: byte-coded method"
self storeBinaryDefinitionBodyOn:stream manager:manager
!
storeFullBinaryDefinitionOn:stream manager:manager
"store full bytecoded-method."
|m code srcPos|
ObjectMemory snapshotID storeBinaryOn:stream manager:manager.
category storeBinaryOn:stream manager:manager.
byteCode isNil ifTrue:[
m := self asByteCodeMethod.
code notNil ifTrue:[
code := m byteCode
] ifFalse:[
m := self
]
] ifFalse:[
m := self.
code := byteCode
].
m flags storeBinaryOn:stream manager:manager.
m literals storeBinaryOn:stream manager:manager.
manager sourceMode == #discard ifTrue:[
nil storeBinaryOn:stream manager:manager. "/ sourceFileName
nil storeBinaryOn:stream manager:manager. "/ sourcePosition
nil storeBinaryOn:stream manager:manager. "/ source
] ifFalse:[
m sourceFilename storeBinaryOn:stream manager:manager.
manager sourceMode == #reference ifTrue:[
srcPos := m sourcePosition.
] ifFalse:[
srcPos := nil
].
srcPos storeBinaryOn:stream manager:manager.
srcPos isNil ifTrue:[
m source storeBinaryOn:stream manager:manager.
].
].
code storeBinaryOn:stream manager:manager.
"Created: 16.1.1996 / 14:41:45 / cg"
! !
!Method methodsFor:'copying'!
copy
"redefined to change source ref into a real string"
|aCopy|
aCopy := super copy.
sourcePosition notNil ifTrue:[
aCopy source:(self source)
].
^ aCopy
! !
!Method methodsFor:'error handling'!
invalidCodeObject
"this method is triggered by the interpreter when a nil or non method
is about to be executed.
In this case, the VM sends this to the bad method (the receiver).
Also, the Compiler creates methods with their code/bytecode set to
this method if - after a class change - a method cannot be compiled
and is therefore no longer executable (for example, after an instvar
has been removed, and a method still tries to access this instvar)
Thus, we arrive here, when playing around in a classes methodArray,
or compiler/runtime system is broken :-(,
or you ignore the error messages during some recompile."
^ InvalidCodeSignal
raiseRequestWith:self
errorString:'invalid method - not executable'.
!
privateMethodCalled
"this error is triggered, if a private or protected method is called.
If you continue in the debugger, the method will be called,
and further privacy exceptions will NOT be reported at this call location,
until any new method is compiled, or the privacy of any method changes,
or the caches are flushed.
(the reason is that after the continue, the method is enterred into the
calling cache, for which method privacy is not checked.
Any of the above actions flushes this cache and a privacy check
is performed again.)
Future versions may not enter private methods into the cache, to fix this
(unobvious) behavior. However, then you will get an exception for EVERY
call to a private method ...
Notice: method privacy is a nonstandard feature, not supported
by other smalltalk implementations and not specified in the ANSI spec.
This is EXPERIMENTAL - and being evaluated for usability.
It may change or even vanish (if it shows to be not useful)."
^ PrivateMethodSignal raise
!
uncompiledCodeObject
"this method is invoked by methods which contain primitive code,
but have not been compiled to machine code (either due to an error
when compiling, or simply because no stc is available.
For those methods, the compiler generated a method object consisting
of the original source code, but with this methods machine/byte code.
Therefore, we patch (kludge) the lineNumber information, to show the
first line (instead of the real line below)"
thisContext setLineNumber:1.
^ InvalidCodeSignal
raiseRequestWith:self
errorString:'invalid method - not compiled'.
!
wrongNumberOfArguments:numberGiven
"this error is triggered, if a method is called with a wrong number
of arguments. This only applies to #valueWithReceiverXXX - sends.
With a normal send, this error cannot happen."
^ ArgumentSignal
raiseRequestWith:self
errorString:('method got ' , numberGiven printString ,
' args while ' , self numberOfMethodArgs printString , ' where expected')
! !
!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
sender: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."
^ self valueWithReceiver:anObject
arguments:argArray
selector:aSymbol
search:nil
sender:nil
!
valueWithReceiver:anObject arguments:argArray selector:aSymbol search:aClass sender:virtualSender
"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;
if (__isArray(argArray)) {
nargs = _arraySize(argArray);
ap = _ArrayInstPtr(argArray)->a_element;
} else {
if (argArray == nil) {
nargs = 0;
} else
nargs = -1;
}
#ifdef F_NARGS
if (((_intVal(_INST(flags)) & F_NARGS) >> F_NARGSHIFT) == nargs)
#endif
{
code = _MethodInstPtr(self)->m_code;
if (aClass == nil) {
searchClass = dummy.ilc_class = __Class(anObject);
} else {
searchClass = dummy.ilc_class = aClass;
}
if (nargs <= 15) {
/*
* add virtual sender (unwinding) here later,
* to allow hiding contexts in lazy methods.
* (this is cosmetics only; therefore its done later)
*/
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 */
#ifdef PASS_ARG_POINTER
RETURN ( __interpret(self, nargs, anObject, aSymbol, SND_COMMA searchClass, ap) );
#else
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]) );
}
#endif
}
}
}
%}
.
(argArray isMemberOf:Array) ifFalse:[
"
arguments must be either nil or an array
"
^ self badArgumentArray
].
(argArray size ~~ self numberOfMethodArgs) ifTrue:[
"
the method expects a different number of arguments
"
^ self wrongNumberOfArguments:argArray size
].
"
the VM only supports a limited number of arguments in sends
"
^ self tooManyArguments
"
(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
'the next example is a wrong one - it is nowhere detected
and a wrong value returned ...'.
(Point compiledMethodAt:#x)
valueWithReceiver:(1->2) arguments:nil
'the next example is VERY bad one - it is nowhere detected
and may crash the system WARNING: save your work before doing this ...'.
(Point compiledMethodAt:#x)
valueWithReceiver:(Object new) arguments:nil
'the next example is a wrong one - which is detected here ...'.
(Object compiledMethodAt:#printOn:)
valueWithReceiver:false arguments:nil
'the next example is a wrong one - which is detected here ...'.
(Object compiledMethodAt:#printOn:)
valueWithReceiver:false arguments:#()
"
! !
!Method methodsFor:'printing & storing'!
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."
|classAndSelector m wrapped|
wrapped := false.
aStream nextPutAll:(self classNameWithArticle).
aStream nextPut:$(.
classAndSelector := self who.
classAndSelector isNil ifTrue:[
"
not anchored in any class.
check if wrapped (to be more informative in inspectors)
"
m := self wrapper.
m notNil ifTrue:[
classAndSelector := m who.
wrapped := true.
]
].
classAndSelector notNil ifTrue:[
(classAndSelector at:1) name printOn:aStream.
aStream nextPutAll:' '.
(classAndSelector at:2) printOn:aStream.
wrapped ifTrue:[
aStream nextPutAll:'; wrapped'
].
] ifFalse:[
"
sorry, a method which is nowhere anchored
"
aStream nextPutAll:'unbound'
].
aStream nextPut:$)
"
(Object compiledMethodAt:#at:) printOn:Transcript. Transcript cr.
(Object compiledMethodAt:#at:) copy printOn:Transcript. Transcript cr.
"
!
whoString
"return a string as className>>selector, if this is not an unbound
method. Otherwise return 'unbound'. Used with debugging."
|w|
w := self who.
w notNil ifTrue:[
^ (w at:1) name , '>>' , (w at:2)
].
^ 'unbound'
"
Method new whoString
(Method compiledMethodAt:#whoString) whoString
"
! !
!Method methodsFor:'queries'!
containingClass
"return the class I am defined in.
See comment in who."
"based on who, which has been added for ST-80 compatibility"
|pair|
pair := self who.
pair notNil ifTrue:[^ pair at:1].
"
none found - sorry
"
^ nil
"
|m|
m := Object compiledMethodAt:#at:.
m containingClass
"
!
hasPrimitiveCode
"return true, if the method contains primitive code; false if not.
Uses Parser to parse methods source and get the information."
|src|
src := self source.
src notNil ifTrue:[
(src includesString:'%{' ) ifFalse:[
"/ cannot contain primitive code.
^ false
]
].
^ self parse:#'parseMethodSilent:' return:#hasPrimitiveCode or:false
"
(Method compiledMethodAt:#hasPrimitiveCode) hasPrimitiveCode
(Object compiledMethodAt:#at:) hasPrimitiveCode
(Object compiledMethodAt:#basicAt:) hasPrimitiveCode
"
"Modified: 31.10.1995 / 14:43:37 / cg"
!
isInvalid
"return true, if this method is not executable due to
a (re)-compilation error. (see comment in Method>>invalidCodeObject)"
|m|
m := Method compiledMethodAt:#invalidCodeObject.
self ~~ m ifTrue:[
(self code notNil and:[self code = m code]) ifTrue:[^ true].
(byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
m := Method compiledMethodAt:#uncompiledCodeObject.
self ~~ m ifTrue:[
(self code notNil and:[self code = m code]) ifTrue:[^ true].
(byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
m := Metaclass compiledMethodAt:#invalidCodeObject.
self ~~ m ifTrue:[
(self code notNil and:[self code = m code]) ifTrue:[^ true].
(byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
^ false
!
isLazyMethod
"return true, if this is a lazy method.
False is returned here - this method is redefined in LazyMethod"
^ false
!
isMethod
"return true, if the receiver is some kind of method;
true returned here - the method is redefined from Object."
^ true
!
isWrapped
"return true, if this is a wrapper method.
False is returned here - this method is redefined in WrappedMethod"
^ false
!
methodArgAndVarNames
"return a collection with the methods argument and variable names.
Uses Parser to parse methods source and extract the names.
Returns nil if the source is not available, or some other
syntax/parse error occurred. For methods with no args and no vars,
an empty collection is returned."
|parser sourceString argNames varNames|
sourceString := self source.
sourceString notNil ifTrue:[
parser := Parser parseMethodArgAndVarSpecificationSilent: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
"
!
methodArgNames
"return a collection with the methods argument names.
Uses Parser to parse methods source and extract the names."
^ self parse:#'parseMethodSpecificationSilent:' return:#methodArgs or:nil
"
(Method compiledMethodAt:#printOn:) methodArgNames
"
"Modified: 31.10.1995 / 14:36:46 / cg"
!
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 asCollectionOfLines.
(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
"
!
methodVarNames
"return a collection with the methods local-variable names.
Uses Parser to parse methods source and extract the names."
^ self parse:#'parseMethodArgAndVarSpecificationSilent:' return:#methodVars or:nil
"
(Method compiledMethodAt:#printOn:) methodVarNames
"
"Modified: 31.10.1995 / 14:36:49 / cg"
!
modificationTime
"try to extract the modificationTime as a timeStamp from
the receivers source. If there is no source or no history line,
we do not know the modification time, and nil is returned."
|s list histLine|
HistoryManager isNil ifTrue:[^ nil].
s := self source.
s isNil ifTrue:[^ nil].
list := HistoryManager getAllHistoriesFrom:s.
list size == 0 ifTrue:[^ nil].
histLine := list last.
^ AbsoluteTime date:histLine date time:histLine time
"
(Method compiledMethodAt:#modificationTime) modificationTime
(Method compiledMethodAt:#isMethod) modificationTime
"
"Modified: 8.9.1995 / 15:08:22 / claus"
!
parse:parseSelector return:accessSelector or:valueIfNoSource
"helper for methodArgNames, methodVarNames etc.
Get the source, let parser parse it using parseSelector,
return parser info using accessSelector"
|parser sourceString|
sourceString := self source.
sourceString notNil ifTrue:[
parser := Parser perform:parseSelector with:sourceString.
(parser isNil or:[parser == #Error]) ifTrue:[^ nil].
^ parser perform:accessSelector
].
^ valueIfNoSource
!
referencesGlobal:aGlobalSymbol
"return true, if this method references the global
bound to aGlobalSymbol."
|lits|
(lits := self literals) isNil ifTrue:[^ false].
^ (lits identityIndexOf:aGlobalSymbol startingAt:1) ~~ 0
!
selector
"return the selector under which I am found in my containingClasses
method-table.
See comment in who."
"based on who, which has been added for ST-80 compatibility"
|pair|
pair := self who.
pair notNil ifTrue:[^ pair at:2].
"
none found - sorry
"
^ nil
"
|m|
m := Object compiledMethodAt:#at:.
m selector
"
!
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
!
who
"return the class and selector of where I am defined in.
Since there is no information of the containing class
in the method, we have to do a search here.
Normally, this is not a problem, except when a method is
accepted in the debugger or redefined from within a method
(maybe done indirectly, if doIt is done recursively)
- the information about which class the original method was
defined in is lost in this case.
Problem: this is heavily called for in the debugger to create
a readable context walkback. For unbound methods, it is
slow, since the search (over all classes) will always fail.
Q: should we add a backref from the method to the class
and/or add a subclass of Method for unbound ones ?"
|classes cls sel|
"
very first, look in the class we found something the last time
this may often give a hit, when asking who repeatingly for
a context chain. (keep last by its name, to not keep classes from
being garbage collected)
"
LastWhoClass notNil ifTrue:[
cls := Smalltalk at:LastWhoClass.
cls notNil ifTrue:[
sel := cls selectorAtMethod:self.
sel notNil ifTrue:[^ Array with:cls with:sel].
]
].
"
first, limit the search to global classes only -
since probability is high, that the receiver is found in there ...
"
classes := Smalltalk allClasses.
"
instance methods are usually more common - search those first
"
classes do:[:aClass |
|sel|
sel := aClass selectorAtMethod:self.
sel notNil ifTrue:[LastWhoClass := aClass name.
^ Array with:aClass with:sel].
].
LastWhoClass := nil.
classes do:[:aClass |
|sel|
sel := aClass class selectorAtMethod:self.
sel notNil ifTrue:[^ Array with:aClass class with:sel].
].
"
mhmh - must be a method of some anonymous class (i.e. one not
in the Smalltalk dictionary). Search all instances of Behavior
"
Behavior allSubInstancesDo:[:someClass |
|sel|
sel := someClass selectorAtMethod:self.
sel notNil ifTrue:[^ Array with:someClass with:sel]
].
"
none found - sorry
"
^ nil
"typical situation: some well-known class"
"
|m|
m := Object compiledMethodAt:#copy.
m who
"
"untypical situation: an anonymous class"
"
|m cls|
Object
subclass:#FunnyClass
instanceVariableNames:'foo'
classVariableNames:''
poolDictionaries:''
category:'testing'.
cls := Smalltalk at:#FunnyClass.
Smalltalk removeClass:cls.
cls compile:'testMethod1:arg foo:=arg'.
cls compile:'testMethod2 ^ foo'.
m := cls compiledMethodAt:#testMethod1:.
m who
"
!
wrapper
"only for wrapped methods: return the wrapper.
Thats the WrapperMethod which contains myself."
WrappedMethod allInstancesDo:[:m |
m originalMethod == self ifTrue:[^ m].
].
^ nil
! !
!Method methodsFor:'trap methods'!
makeInvalid
"make the receiver an invalid method, which raises an invalidCodeObject
signal when executed. This is not for public use - it is required for
the objectFileLoader to invalidate methods whose code is unloaded."
|invldMethod|
invldMethod := self class compiledMethodAt:#invalidCodeObject.
self code:invldMethod code.
self byteCode:invldMethod byteCode.
"Created: 17.9.1995 / 15:00:52 / claus"
!
makeUncompiled
"make the receiver an uncompiled method, which raises an invalidCodeObject
signal when executed. This is not for public use - it is required for
the compiler to invalidate methods which cannot be compiled due to errors
after a class definition change (for example: instvars are no longer there)."
|invldMethod|
invldMethod := self class compiledMethodAt:#uncompiledCodeObject.
self code:invldMethod code.
self byteCode:invldMethod byteCode.
"Created: 17.9.1995 / 15:01:14 / claus"
! !
!Method class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.77 1996-03-07 18:34:00 cg Exp $'
! !
Method initialize!