--- a/Method.st Fri Feb 25 13:59:09 1994 +0100
+++ b/Method.st Fri Feb 25 14:00:53 1994 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Method.st,v 1.10 1994-02-05 12:22:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Method.st,v 1.11 1994-02-25 13:00:39 claus Exp $
written spring 89 by claus
'!
@@ -233,7 +233,10 @@
"set the flags (number of method variables, stacksize)
- for use by the compiler only"
- flags := newFlags
+ "protect myself a bit - putting in an object would crash me ..."
+ (newFlags isMemberOf:SmallInteger) ifTrue:[
+ flags := newFlags
+ ]
!
dynamic:aBoolean
@@ -241,18 +244,16 @@
dynamically and should be flushed on image-restart.
- for use by compiler only."
- |newFlags|
+%{ /* NOCONTEXT */
+ int f = _intVal(_INST(flags));
- newFlags := flags.
-%{
/* made this a primitive to get define in stc.h */
if (aBoolean == true)
- newFlags = _MKSMALLINT(_intVal(newFlags) | F_DYNAMIC);
+ f = f | F_DYNAMIC;
else
- newFlags = _MKSMALLINT(_intVal(newFlags) & ~F_DYNAMIC);
+ f = f & ~F_DYNAMIC;
+ _INST(flags) = _MKSMALLINT(f);
%}
-.
- flags := newFlags
!
numberOfMethodArgs:aNumber
@@ -265,40 +266,52 @@
in a later release, allowing any number of arguments.
- for use by compiler only."
- aNumber > self class maxNumberOfArguments ifTrue:[
- self error:('methods support a maximum of ' ,
+ (aNumber between:0 and:self class maxNumberOfArguments) ifFalse:[
+ self error:('ST/X only supports up to a maximum of ' ,
self class maxNumberOfArguments printString ,
- ' arguments')
- ]
+ ' 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 current implementation simply counts the arguments from
- the methods source - future versions will include this information
+ 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.
- Warning: playing around here with incorrect values
- may crash smalltalk badly.
- - for use by compiler only."
+ "set the number of method variables - for use by compiler only.
+ Warning: playing around here with incorrect values may crash smalltalk badly."
- |newFlags|
+%{ /* NOCONTEXT */
+ int f = _intVal(_INST(flags));
- newFlags := flags.
-%{
/* made this a primitive to get define in stc.h */
- newFlags = _MKSMALLINT((_intVal(newFlags) & ~F_NVARS)
- | (_intVal(aNumber) << F_NVARSHIFT));
+ if (_isSmallInteger(aNumber)) {
+ f = (f & ~F_NVARS) | (_intVal(aNumber) << F_NVARSHIFT);
+ _INST(flags) = _MKSMALLINT(f);
+ }
%}
-.
- flags := newFlags
!
numberOfMethodVars
@@ -310,28 +323,25 @@
%{ /* NOCONTEXT */
/* made this a primitive to get define in stc.h */
- int flagBits = _intVal(_INST(flags));
-
- RETURN (_MKSMALLINT((flagBits & F_NVARS) >> F_NVARSHIFT));
+ RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NVARS) >> F_NVARSHIFT));
%}
!
stackSize:aNumber
- "set the depth of the local stack.
- Warning: playing around here with incorrect values
- may crash smalltalk badly.
- - for use by compiler only."
-
- |newFlags|
+ "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)"
- newFlags := flags.
-%{
+%{ /* NOCONTEXT */
+ int f = _intVal(_INST(flags));
+
/* made this a primitive to get define in stc.h */
- newFlags = _MKSMALLINT((_intVal(newFlags) & ~F_NSTACK)
- | (_intVal(aNumber) << F_NSTACKSHIFT));
+ if (_isSmallInteger(aNumber)) {
+ f = (f & ~F_NSTACK) | (_intVal(aNumber) << F_NSTACKSHIFT);
+ _INST(flags) = _MKSMALLINT(f);
+ }
%}
-.
- flags := newFlags
!
stackSize
@@ -343,21 +353,20 @@
%{ /* NOCONTEXT */
/* made this a primitive to get define in stc.h */
- int flagBits = _intVal(_INST(flags));
-
- RETURN (_MKSMALLINT((flagBits & F_NSTACK) >> F_NSTACKSHIFT));
+ RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NSTACK) >> F_NSTACKSHIFT));
%}
! !
!Method methodsFor:'queries'!
containingClass
- "return the class I am defined in
- - stupid, there is no information of the containing class
- in the method, so we have to search here."
+ "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 containsMethod:self) ifTrue:[^ aClass].
+ (aClass class containsMethod:self) ifTrue:[^ aClass class]
].
^ nil
!
@@ -513,7 +522,8 @@
(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
+ 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."
@@ -525,7 +535,7 @@
int nargs;
OBJ *ap;
- if (_isArray(argArray)) {
+ if (__isArray(argArray)) {
nargs = _arraySize(argArray);
ap = _ArrayInstPtr(argArray)->a_element;
} else {
@@ -598,47 +608,58 @@
"(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:nilfalse"
+ "(True compiledMethodAt:#printString) valueWithReceiver:false arguments:nil"
! !
!Method methodsFor:'printing'!
printOn:aStream
- "put a printed representation of the receiver onto 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."
- |homeClass|
+ |myClass|
- homeClass := self containingClass.
- homeClass notNil ifTrue:[
- aStream nextPutAll:'a Method in '.
- homeClass name printOn:aStream.
+ aStream nextPutAll:'a Method('.
+ myClass := self containingClass.
+ myClass notNil ifTrue:[
+ myClass name printOn:aStream.
aStream nextPutAll:' '.
- (homeClass selectorForMethod:self) printOn:aStream
+ (myClass selectorForMethod:self) printOn:aStream
] ifFalse:[
- aStream nextPutAll:'a Method'
- ]
+ aStream nextPutAll:'???'
+ ].
+ aStream nextPut:$)
! !
!Method methodsFor:'binary storage'!
storeBinaryDefinitionOn: stream manager: manager
- "can only store bytecode - machine code is lost"
+ "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|
+ |temporaryMethod cls source|
byteCode isNil ifTrue:[
cls := self containingClass.
- temporaryMethod := cls compiler compile:(self source)
- forClass:cls
- inCategory:(self category)
- notifying:nil
- install:false.
- ^ temporaryMethod storeBinaryDefinitionOn: stream manager: manager
+ 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:'binary fileOut'!
+!Method methodsFor:'obsolete binary fileOut'!
binaryFileOutLiteralsOn:aStream
|index n|
@@ -668,7 +689,7 @@
aStream nextPutAll:'(Smalltalk at:#'.
n := lit name.
lit isMeta ifTrue:[
- n := (n copyFrom:1 to:(n size - 5)) , ') class'
+ n := (n copyTo:(n size - 5)) , ') class'
] ifFalse:[
n := n , ')'
].