"
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 package'
classVariableNames:'PrivateMethodSignal'
poolDictionaries:''
category:'Kernel-Methods'
!
Method comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libbasic/Method.st,v 1.19 1994-10-10 00:26:43 claus Exp $
'!
!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.19 1994-10-10 00:26:43 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.
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
(nil if its the standard system package)
WARNING: layout known by compiler and runtime system - dont change
"
! !
!Method class methodsFor:'initialization'!
initialize
PrivateMethodSignal isNil ifTrue:[
ExecutableCodeObject initialize.
"EXPERIMENTAL"
PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.
PrivateMethodSignal nameClass:self message:#privateMethodSignal.
PrivateMethodSignal notifierString:'attempt to execute private method'.
]
! !
!Method class methodsFor:'signal access'!
privateMethodSignal
^ PrivateMethodSignal
! !
!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"
! !
!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 (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
"
!
category
"return the methods category or nil"
^ category
!
category:aStringOrSymbol
"set the methods category"
category := aStringOrSymbol asSymbol
!
package
"return the package-symbol"
^ package
!
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 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
%}
!
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
!
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 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);
}
%}
!
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'!
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.
Q: should we add a backref from the method to the class ?"
"
first, limit the search to global classes only -
since probability is high, that the receiver is found in there ...
"
Smalltalk allBehaviorsDo:[:aClass |
|sel|
sel := aClass selectorForMethod:self.
sel notNil ifTrue:[^ Array with:aClass with:sel].
sel := aClass class selectorForMethod: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 allDerivedInstancesDo:[:someClass |
|sel|
sel := someClass selectorForMethod: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
"
!
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
!
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 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
"
!
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
!
isLazyMethod
"return true, if this is a lazy method.
False is returned here - this method is redefined in LazyMethod"
^ false
!
isWrapped
"return true, if this is a wrapper method.
False is returned here - this method is redefined in WrappedMethod"
^ false
!
isInvalid
"return true, if this method is not executable due to
a (re)-compilation error. (see comment in Method>>invalidMethod)"
|m|
m := Method compiledMethodAt:#invalidMethod.
(self code notNil and:[self code == m code]) ifTrue:[^ true].
(byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
^ false
! !
!Method methodsFor:'error handling'!
invalidMethod
"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'.
!
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')
!
privateMethodCalled
"this error is triggered, if a private method is called from
outside (i.e. not via a self-send and not via a super-send.
Methodprivacy is an EXPERIMENTAL feature."
^ PrivateMethodSignal raise
! !
!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;
}
#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 (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:[
"
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."
|myClass|
aStream nextPutAll:(self classNameWithArticle).
aStream nextPut:$(.
myClass := self containingClass.
myClass notNil ifTrue:[
myClass name printOn:aStream.
aStream nextPutAll:' '.
(myClass selectorForMethod:self) printOn:aStream
] ifFalse:[
aStream nextPutAll:'no class'
].
aStream nextPut:$)
! !
!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
! !
!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)."
|temporaryMethod cls sourceString upd silent lazy|
byteCode notNil ifTrue:[
"
is already a bytecoded method
"
^ self
].
cls := self containingClass.
cls isNil ifTrue:[
'cannot generate bytecode (no class for compilation)' errorPrintNL.
^ nil
].
sourceString := self source.
sourceString isNil ifTrue:[
'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 ...
"
upd := Class updateChanges:false.
silent := Smalltalk silentLoading:true.
lazy := Compiler compileLazy:false.
[
temporaryMethod := cls compiler compile:sourceString
forClass:cls
inCategory:(self category)
notifying:nil
install:false.
] valueNowOrOnUnwindDo:[
Class updateChanges:upd.
Compiler compileLazy:lazy.
Smalltalk silentLoading:silent.
].
(temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
'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
"
(LargeInteger compiledMethodAt:#normalize) asByteCodeMethod
(SmallInteger compiledMethodAt:#+) asByteCodeMethod
"
!
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 putIdOf:(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 putIdOf:(self class) on:stream.
stream nextPutByte:1. "means byte-coded method"
self storeBinaryDefinitionBodyOn:stream manager:manager
!
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
! !