"
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.
"
Object subclass:#Method
instanceVariableNames:'code flags byteCode literals
source sourcePosition category'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Methods'
!
Method comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libbasic/Method.st,v 1.11 1994-02-25 13:00:39 claus Exp $
written spring 89 by claus
'!
!Method class methodsFor:'documentation'!
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.
The methods source-code is represented by source and sourcePosition:
if sourcePosition is a Number, the source-field is the fileName and
sourcePosition is the character offset of the source-chunk in this source file.
If sourcePosition is nil, the source is the string in the source field.
The flags field defines things like the number of method-locals,
method arguments and stack size need (for interpreted methods).
Do not depend on any value in the flags field - it may change without
notice.
WARNING: layout known by compiler and runtime system - dont change
"
! !
!Method class methodsFor:'queries'!
isBuiltInClass
"this class is known by the run-time-system"
^ self == Method
!
maxNumberOfArguments
"this limit will be removed in one of the next versions ..."
^ 12 "cannot be easily changed"
! !
!Method methodsFor:'accessing'!
instVarAt:index
"redefined to catch access to code-field - it is a non-object"
index == 1 ifTrue:[^ self code].
^ super instVarAt:index
!
instVarAt:index put:value
"redefined to catch access to code-field - it is a non-object"
index == 1 ifTrue:[^ self code:value].
^ super instVarAt:index put:value
!
code
"return code field - since its a non-object return address as integer"
%{
if (_MethodInstPtr(self)->m_code != (OBJFUNC)0) {
RETURN ( _MKSMALLINT((int)(_MethodInstPtr(self)->m_code)) );
}
%}.
^ nil
!
code:anAddress
"set the code field - you should know what you do if doing this -
should only be done by compiler.
Smalltalk can crash badly if playing around here ..."
%{
if (_isSmallInteger(anAddress))
_INST(code) = (OBJ)(_intVal(anAddress));
else
_INST(code) = nil;
%}
!
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 searchinbg for and returning the first comment
from the source. returns nil if there is no comment (or source
is not available)"
|text line nQuote index i1 i2 commLines|
text := self source.
text isNil ifTrue:[^ nil].
text := text asText.
(text size < 2) ifTrue:[^ nil].
line := (text at:2).
nQuote := line occurrencesOf:(Character doubleQuote).
(nQuote == 0) ifTrue:[^ nil].
(nQuote == 2) ifTrue:[^ line].
(nQuote > 2) ifTrue:[
i1 := line indexOf:(Character doubleQuote).
i2 := line indexOf:(Character doubleQuote) startingAt:(i1 + 1).
^ line copyFrom:i1+1 to:i2-1
].
commLines := Text new.
commLines add:line.
index := 3.
line := text at:index.
nQuote := line occurrencesOf:(Character doubleQuote).
[nQuote ~~ 1] whileTrue:[
commLines add:line.
index := index + 1.
index > text size ifTrue:[^ nil]. "unclosed comment - could warn here"
line := text at:index.
nQuote := line occurrencesOf:(Character doubleQuote)
].
^ commLines asString
"(Method compiledMethodAt:#comment) comment"
!
literals
"return the methods literal array"
^ literals
!
literals:anArray
"set the methods literal array"
literals := anArray
!
byteCode
"return the methods byteCode array"
^ byteCode
!
byteCode:aByteArray
"set the methods byteCode array"
byteCode := aByteArray
!
category
"return the methods category or nil"
^ category
!
category:aStringOrSymbol
"set the methods category"
category := aStringOrSymbol asSymbol
!
flags
"return the flags (number of method variables, stacksize etc.).
Dont depend on the values in the flag field - it may change
without notice."
^ flags
!
flags:newFlags
"set the flags (number of method variables, stacksize)
- for use by the compiler only"
"protect myself a bit - putting in an object would crash me ..."
(newFlags isMemberOf:SmallInteger) ifTrue:[
flags := newFlags
]
!
dynamic:aBoolean
"set the flag bit stating that the machine code was created
dynamically and should be flushed on image-restart.
- for use by compiler only."
%{ /* NOCONTEXT */
int f = _intVal(_INST(flags));
/* made this a primitive to get define in stc.h */
if (aBoolean == true)
f = f | F_DYNAMIC;
else
f = f & ~F_DYNAMIC;
_INST(flags) = _MKSMALLINT(f);
%}
!
numberOfMethodArgs:aNumber
"currently, the number of arguments is NOT remembered in
methods, but this will be added soon to allow for more checking
in #perform:.
The limitation in the max. number of arguments is due to the
missing SENDxx functions in the VM. This too will be removed
in a later release, allowing any number of arguments.
- for use by compiler only."
(aNumber between:0 and:self class maxNumberOfArguments) ifFalse:[
self error:('ST/X only supports up to a maximum of ' ,
self class maxNumberOfArguments printString ,
' method arguments').
^ self
].
%{
/* made this a primitive to get define in stc.h */
#ifdef F_NARGS
_INST(flags) = _MKSMALLINT( (_intVal(_INST(flags)) & ~F_NARGS) | (_intVal(aNumber) << F_NARGSHIFT) );
#endif
%}
!
numberOfMethodArgs
"return the number of arguments, the method expects."
%{ /* NOCONTEXT */
/* made this a primitive to get define in stc.h */
#ifdef F_NARGS
RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NARGS) >> F_NARGSHIFT));
#endif
%}
.
"
The old implementation simply counted the arguments from
the methods source - new versions include this information
in the flag instVar, for more protection in #perform:"
^ self methodArgNames size
!
numberOfMethodVars:aNumber
"set the number of method variables - for use by compiler only.
Warning: playing around here with incorrect values may crash smalltalk badly."
%{ /* NOCONTEXT */
int f = _intVal(_INST(flags));
/* made this a primitive to get define in stc.h */
if (_isSmallInteger(aNumber)) {
f = (f & ~F_NVARS) | (_intVal(aNumber) << F_NVARSHIFT);
_INST(flags) = _MKSMALLINT(f);
}
%}
!
numberOfMethodVars
"return the number of method local variables.
Do not depend on the returned value - future optimizations
may change things here.
- for debugging only."
%{ /* NOCONTEXT */
/* made this a primitive to get define in stc.h */
RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NVARS) >> F_NVARSHIFT));
%}
!
stackSize:aNumber
"set the depth of the local stack - for use by compiler only.
Warning: playing around here with incorrect values may crash smalltalk badly.
(if the runtime library was compiled with DEBUG, a bad stack will be
cought and trigger an error though)"
%{ /* NOCONTEXT */
int f = _intVal(_INST(flags));
/* made this a primitive to get define in stc.h */
if (_isSmallInteger(aNumber)) {
f = (f & ~F_NSTACK) | (_intVal(aNumber) << F_NSTACKSHIFT);
_INST(flags) = _MKSMALLINT(f);
}
%}
!
stackSize
"return the number of temporaries needed as stack in the context.
Do not depend on the returned value - future optimizations
may change things here.
- for debugging only."
%{ /* NOCONTEXT */
/* made this a primitive to get define in stc.h */
RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NSTACK) >> F_NSTACKSHIFT));
%}
! !
!Method methodsFor:'queries'!
containingClass
"return the class I am defined in.
Since there is no information of the containing class
in the method, we have to search here."
Smalltalk allBehaviorsDo:[:aClass |
(aClass containsMethod:self) ifTrue:[^ aClass].
(aClass class containsMethod:self) ifTrue:[^ aClass class]
].
^ 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 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 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 ifTrue:[^ nil].
argNames := parser methodArgs.
varNames := parser methodVars.
argNames isNil ifTrue:[^ varNames].
varNames isNil ifTrue:[^ argNames].
^ (argNames , varNames)
].
^ nil
"(Method compiledMethodAt:#printOn:) methodArgAndVarNames"
!
methodComment
"return the methods first comment, nil if there is none.
This is a somewhat stupid implementation."
|text line nQuote index qIndex qIndex2 comment|
text := self source asText.
(text size < 2) ifTrue:[^nil].
line := (text at:2).
nQuote := line occurrencesOf:(Character doubleQuote).
(nQuote == 2) ifTrue:[
qIndex := line indexOf:(Character doubleQuote).
qIndex2 := line indexOf:(Character doubleQuote) startingAt:(qIndex + 1).
^ line copyFrom:(qIndex + 1) to:(qIndex2 - 1)
].
(nQuote == 1) ifTrue:[
qIndex := line indexOf:(Character doubleQuote).
comment := line copyFrom:(qIndex + 1).
index := 3.
line := text at:index.
nQuote := line occurrencesOf:(Character doubleQuote).
[nQuote ~~ 1] whileTrue:[
comment := comment , Character cr asString , line withoutSpaces.
index := index + 1.
line := text at:index.
nQuote := line occurrencesOf:(Character doubleQuote)
].
qIndex := line indexOf:(Character doubleQuote).
^ comment , Character cr asString , (line copyTo:(qIndex - 1)) withoutSpaces
].
^ nil
"(Method compiledMethodAt:#methodComment) methodComment"
!
referencesGlobal:aGlobalSymbol
"return true, if this method references the global
bound to aGlobalSymbol."
literals isNil ifTrue:[^ false].
^ (literals identityIndexOf:aGlobalSymbol startingAt:1) ~~ 0
!
sends:aSelectorSymbol
"return true, if this method contains a message-send
with aSelectorSymbol as selector.
- due to the simple check in the literal array, also simple uses
of aSelectorSymbol as symbol will return true.
Should ask compiler, if there is really a send."
^ self referencesGlobal:aSelectorSymbol
! !
!Method methodsFor:'error handling'!
invalidMethod
"this error is triggered by the interpreter when an invalid method
is about to be executed, by sending the bad method this message.
When recompiling classes after a definition-change, all
uncompilable methods will be bound to this method here,
so that evaluating such an uncompilable method will trigger an error.
Can also happen when Compiler/runtime system is broken."
self error:'invalid method - not executable'
!
invalidByteCode
"this error is triggered when the bytecode-interpreter tries to
execute an invalid bytecode.
Can only happen when Compiler/runtime system is broken."
self error:'invalid byteCode in method - not executable'
!
receiverNotBoolean
"this error is triggered when the bytecode-interpreter tries to
execute ifTrue:/ifFalse or whileTrue: type of expressions where the
receiver is neither true nor false."
self error:'if/while on non-boolean receiver'
! !
!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 stup and recalling the original),
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.
BE 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;
}
code = _MethodInstPtr(self)->m_code;
searchClass = dummy.ilc_class = _Class(anObject);
switch (nargs) {
case 0:
RETURN ( (*code)(anObject, nil, SND_COMMA searchClass, &dummy) );
case 1:
RETURN ( (*code)(anObject, nil, SND_COMMA searchClass, &dummy, ap[0]) );
case 2:
RETURN ( (*code)(anObject, nil, SND_COMMA searchClass, &dummy, ap[0], ap[1]) );
case 3:
RETURN ( (*code)(anObject, nil, SND_COMMA searchClass, &dummy, ap[0], ap[1], ap[2]) );
case 4:
RETURN ( (*code)(anObject, nil, SND_COMMA searchClass, &dummy,
ap[0], ap[1], ap[2], ap[3]) );
case 5:
RETURN ( (*code)(anObject, nil, SND_COMMA searchClass, &dummy,
ap[0], ap[1], ap[2], ap[3], ap[4]) );
case 6:
RETURN ( (*code)(anObject, nil, SND_COMMA searchClass, &dummy,
ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
case 7:
RETURN ( (*code)(anObject, nil, SND_COMMA searchClass, &dummy,
ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
case 8:
RETURN ( (*code)(anObject, nil, 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, nil, 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, nil, 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, nil, 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, nil, 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]) );
}
%}
.
(argArray isMemberOf:Array) ifFalse:[
^ self error:'argumentArray must be an Array'
].
^ self error:'too many arguments'
"(Float compiledMethodAt:#+) valueWithReceiver:1.0 arguments:#(2.0)"
"the next example is a wrong one - which is detected by True's method ..."
"(True compiledMethodAt:#printString) valueWithReceiver:false arguments:nil"
! !
!Method methodsFor:'printing'!
printOn:aStream
"put a printed representation of the receiver onto aStream.
Since methods do not store their class/selector, we have to search
for it here."
|myClass|
aStream nextPutAll:'a Method('.
myClass := self containingClass.
myClass notNil ifTrue:[
myClass name printOn:aStream.
aStream nextPutAll:' '.
(myClass selectorForMethod:self) printOn:aStream
] ifFalse:[
aStream nextPutAll:'???'
].
aStream nextPut:$)
! !
!Method methodsFor:'binary storage'!
storeBinaryDefinitionOn: stream manager: manager
"can only store bytecode - machine code is not storable.
If the receiver method is a built-in (i.e. machine coded)
method, a temporary interpreted byte code method is created,
and that bytecode stored.
This works only, if the source of the method is available"
|temporaryMethod cls source|
byteCode isNil ifTrue:[
cls := self containingClass.
source := self source.
source notNil ifTrue:[
temporaryMethod := cls compiler compile:(self source)
forClass:cls
inCategory:(self category)
notifying:nil
install:false.
^ temporaryMethod storeBinaryDefinitionOn:stream manager:manager
].
self error:'store of built-in method failed (no source for compilation)'
].
^ super storeBinaryDefinitionOn: stream manager: manager
! !
!Method methodsFor:'obsolete binary fileOut'!
binaryFileOutLiteralsOn:aStream
|index n|
literals isNil ifTrue:[
aStream nextPutAll:'0'.
aStream nextPut:$!!.
^ self
].
aStream nextPutAll:literals size printString.
aStream nextPut:$!!.
index := 1.
literals do:[:lit |
lit isNumber ifTrue:[
lit storeOn:aStream
] ifFalse:[
((lit isKindOf:String) or:[lit isKindOf:Character]) ifTrue:[
lit storeOn:aStream
] ifFalse:[
(lit isKindOf:Array) ifTrue:[
aStream nextPut:$(.
lit storeOn:aStream.
aStream nextPut:$)
] ifFalse:[
lit isBehavior ifTrue:[
aStream nextPutAll:'(Smalltalk at:#'.
n := lit name.
lit isMeta ifTrue:[
n := (n copyTo:(n size - 5)) , ') class'
] ifFalse:[
n := n , ')'
].
aStream nextPutAll:n
] ifFalse:[
self error:('invalid literal ' , lit class name)
]
]
]
].
aStream nextPut:$!!.
index := index + 1
]
!
binaryFileOutOn:aStream
byteCode isNil ifTrue:[
self notify:'no bytecodes to fileout'.
^ self
].
self binaryFileOutLiteralsOn:aStream.
flags storeOn:aStream.
aStream nextPut:$!!.
byteCode size storeOn:aStream.
aStream nextPut:$!!.
aStream nextPutBytes:(byteCode size) from:byteCode
! !