hg/stx-libbasic: comparison Method.st

equal deleted inserted replaced

-:4a82f332c3f8
+:be0ed17e6f85
 Method comment:'
 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
 '!
 !Method class methodsFor:'documentation'!
 flags:newFlags
 "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
 "set the flag bit stating that the machine code was created
 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
 "currently, the number of arguments is NOT remembered in
 methods, but this will be added soon to allow for more checking
 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 > self class maxNumberOfArguments ifTrue:[
+(aNumber between:0 and:self class maxNumberOfArguments) ifFalse:[
-self error:('methods support a maximum of ' ,
+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 old implementation simply counted the arguments from
-the methods source - future versions will include this information
+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.
+"set the number of method variables - for use by compiler only.
-Warning: playing around here with incorrect values
+Warning: playing around here with incorrect values may crash smalltalk badly."
-may crash smalltalk badly.
-- for use by compiler only."
+%{  /* NOCONTEXT */
+int f = _intVal(_INST(flags));
-|newFlags|
-newFlags := flags.
-%{
 /* made this a primitive to get define in stc.h */
-newFlags = _MKSMALLINT((_intVal(newFlags) & ~F_NVARS)
+if (_isSmallInteger(aNumber)) {
-| (_intVal(aNumber) << F_NVARSHIFT));
+f = (f & ~F_NVARS) | (_intVal(aNumber) << F_NVARSHIFT);
-%}
+_INST(flags) = _MKSMALLINT(f);
-.
+}
-flags := newFlags
+%}
 !
 numberOfMethodVars
 "return the number of method local variables.
 Do not depend on the returned value - future optimizations
 - for debugging only."
 %{  /* NOCONTEXT */
 /* made this a primitive to get define in stc.h */
-int flagBits = _intVal(_INST(flags));
+RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NVARS) >> F_NVARSHIFT));
-RETURN (_MKSMALLINT((flagBits & F_NVARS) >> F_NVARSHIFT));
 %}
 !
 stackSize:aNumber
-"set the depth of the local stack.
+"set the depth of the local stack - for use by compiler only.
-Warning: playing around here with incorrect values
+Warning: playing around here with incorrect values may crash smalltalk badly.
-may crash smalltalk badly.
+(if the runtime library was compiled with DEBUG, a bad stack will be
-- for use by compiler only."
+cought and trigger an error though)"
-|newFlags|
+%{  /* NOCONTEXT */
+int f = _intVal(_INST(flags));
-newFlags := flags.
-%{
 /* made this a primitive to get define in stc.h */
-newFlags = _MKSMALLINT((_intVal(newFlags) & ~F_NSTACK)
+if (_isSmallInteger(aNumber)) {
-| (_intVal(aNumber) << F_NSTACKSHIFT));
+f = (f & ~F_NSTACK) | (_intVal(aNumber) << F_NSTACKSHIFT);
-%}
+_INST(flags) = _MKSMALLINT(f);
-.
+}
-flags := newFlags
+%}
 !
 stackSize
 "return the number of temporaries needed as stack in the context.
 Do not depend on the returned value - future optimizations
 - for debugging only."
 %{  /* NOCONTEXT */
 /* made this a primitive to get define in stc.h */
-int flagBits = _intVal(_INST(flags));
+RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NSTACK) >> F_NSTACKSHIFT));
-RETURN (_MKSMALLINT((flagBits & F_NSTACK) >> F_NSTACKSHIFT));
 %}
 ! !
 !Method methodsFor:'queries'!
 containingClass
-"return the class I am defined in
+"return the class I am defined in.
-- stupid, there is no information of the containing class
+Since there is no information of the containing class
-in the method, so we have to search here."
+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
 !
 methodArgNames
 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
+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."
 %{
 OBJ searchClass;
 static struct inlineCache dummy = _DUMMYILC0;
 int nargs;
 OBJ *ap;
-if (_isArray(argArray)) {
+if (__isArray(argArray)) {
 nargs = _arraySize(argArray);
 ap = _ArrayInstPtr(argArray)->a_element;
 } else {
 if (argArray == nil) {
 nargs = 0;
 ].
 ^ 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: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
-|homeClass|
+for it here."
-homeClass := self containingClass.
+|myClass|
-homeClass notNil ifTrue:[
-aStream nextPutAll:'a Method in '.
+aStream nextPutAll:'a Method('.
-homeClass name printOn:aStream.
+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)
-|temporaryMethod cls|
+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.
-temporaryMethod := cls compiler compile:(self source)
+source := self source.
-forClass:cls
+source notNil ifTrue:[
-inCategory:(self category)
+temporaryMethod := cls compiler compile:(self source)
-notifying:nil
+forClass:cls
-install:false.
+inCategory:(self category)
-^ temporaryMethod storeBinaryDefinitionOn: stream manager: manager
+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|
 literals isNil ifTrue:[
 ] ifFalse:[
 lit isBehavior ifTrue:[
 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 , ')'
 ].
 aStream nextPutAll:n
 ] ifFalse:[

changeset 56	be0ed17e6f85
parent 49	f1c2d75f2eb6
child 68	59faa75185ba