--- a/Method.st Fri Oct 28 02:24:57 1994 +0100
+++ b/Method.st Fri Oct 28 02:25:18 1994 +0100
@@ -12,7 +12,7 @@
ExecutableCodeObject subclass:#Method
instanceVariableNames:'source sourcePosition category package'
- classVariableNames:'PrivateMethodSignal'
+ classVariableNames:'PrivateMethodSignal LastFileReference LastSourceFileName'
poolDictionaries:''
category:'Kernel-Methods'
!
@@ -21,7 +21,7 @@
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 $
+$Header: /cvs/stx/stx/libbasic/Method.st,v 1.20 1994-10-28 01:25:18 claus Exp $
'!
!Method class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Method.st,v 1.19 1994-10-10 00:26:43 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Method.st,v 1.20 1994-10-28 01:25:18 claus Exp $
"
!
@@ -78,6 +78,38 @@
WARNING: layout known by compiler and runtime system - dont change
"
+!
+
+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
+ fileIn as a whole as private using #privateMethodsFor: or as
+ protected using #protectedMethodsFor: in the fileIn chunk instead
+ of the well known #methodsFor:.
+ The additional #publicMethodsFor: is for documentation purposes, and
+ is equivalent to #methodsFor.
+
+ 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.
+
+ 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 and the implementation may change (in case of some ANSI
+ standard being defined) - be warned.
+"
! !
!Method class methodsFor:'initialization'!
@@ -89,13 +121,16 @@
"EXPERIMENTAL"
PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.
PrivateMethodSignal nameClass:self message:#privateMethodSignal.
- PrivateMethodSignal notifierString:'attempt to execute private method'.
+ PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
]
! !
!Method class methodsFor:'signal access'!
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
! !
@@ -118,15 +153,52 @@
source
"return the sourcestring for the receiver"
- |aStream junk|
+ |aStream fileName junk|
source notNil ifTrue:[
+ "
+ if sourcePosition is nonNil, its the fileName and
+ sourcePosition is the offset.
+ Otherwise, source is the real source
+ "
sourcePosition isNil ifTrue:[^ source].
- aStream := Smalltalk systemFileStreamFor:('source/' , source).
+"/
+"/ original code:
+"/
+"/ aStream := Smalltalk systemFileStreamFor:('source/' , source).
+"/ aStream notNil ifTrue:[
+"/ aStream position:sourcePosition.
+"/ junk := aStream nextChunk.
+"/ aStream close
+"/ ]
+
+"/
+"/ we keep the last source file open, because open/close
+"/ operations maybe somewhat 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:[
+ fileName := Smalltalk getSystemFileName:('source/' , source).
+ aStream := fileName asFilename readStream.
+ ].
+
aStream notNil ifTrue:[
aStream position:sourcePosition.
junk := aStream nextChunk.
- aStream close
+
+ "
+ keep a weak reference - maybe its needed again soon ...
+ "
+ LastFileReference isNil ifTrue:[
+ LastFileReference := WeakArray new:1
+ ].
+ LastFileReference at:1 put:aStream.
+ LastSourceFileName := source
]
].
^ junk
@@ -215,36 +287,88 @@
]
!
-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."
+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.
+ 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_PRIVATE
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;
+ 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."
+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.
+ 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_CLASSPRIVATE
+ int f = _intVal(_INST(flags));
+
+ f = f | F_CLASSPRIVATE;
+ _INST(flags) = _MKSMALLINT(f);
+#endif
+%}
+!
+
+setToPublic
+ "clear any privacy of the recevier. The receiver may be executed by
+ any send. This is the default."
%{ /* NOCONTEXT */
+ /* I made this a primitive to get the define constant from stc.h */
+
int f = _intVal(_INST(flags));
- /* made this a primitive to get define in stc.h */
+#if F_PRIVATE
+ f = f & ~F_PRIVATE;
+#endif
+#if F_CLASSPRIVATE
+ f = f & ~F_CLASSPRIVATE;
+#endif
+ _INST(flags) = _MKSMALLINT(f);
+%}
+!
+
+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 */
+
#ifdef F_PRIVATE
+ int f = _intVal(_INST(flags));
+
if (f & F_PRIVATE) {
RETURN (true);
}
@@ -253,6 +377,53 @@
^ 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 */
+
+#ifdef F_CLASSPRIVATE
+ int f = _intVal(_INST(flags));
+
+ if (f & 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."
+
+%{ /* NOCONTEXT */
+ /* I made this a primitive to get the define constant from stc.h */
+
+ int f = _intVal(_INST(flags));
+#ifdef F_PRIVATE
+ if (f & F_PRIVATE) {
+ RETURN (false);
+ }
+#endif
+#ifdef F_CLASSPRIVATE
+ if (f & F_CLASSPRIVATE) {
+ RETURN (false);
+ }
+#endif
+%}.
+ ^ true
+!
+
numberOfMethodArgs:aNumber
"currently, the number of arguments is NOT remembered in
methods, but this will be added soon to allow for more checking
@@ -442,6 +613,35 @@
none found - sorry
"
^ nil
+
+ "
+ |m|
+ m := Object compiledMethodAt:#at:.
+ m containingClass
+ "
+!
+
+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
+ "
!
methodArgNames
@@ -622,8 +822,8 @@
!
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.
+ "this error is triggered, if a private or protected method is called from
+ outside.
Methodprivacy is an EXPERIMENTAL feature."
^ PrivateMethodSignal raise
@@ -913,19 +1113,23 @@
Since methods do not store their class/selector, we have to search
for it here."
- |myClass|
+ |classAndSelector|
aStream nextPutAll:(self classNameWithArticle).
aStream nextPut:$(.
- myClass := self containingClass.
- myClass notNil ifTrue:[
- myClass name printOn:aStream.
+ classAndSelector := self who.
+ classAndSelector notNil ifTrue:[
+ (classAndSelector at:1) name printOn:aStream.
aStream nextPutAll:' '.
- (myClass selectorForMethod:self) printOn:aStream
+ ((classAndSelector at:2)) printOn:aStream
] ifFalse:[
aStream nextPutAll:'no class'
].
aStream nextPut:$)
+
+ "
+ (Object compiledMethodAt:#at:) printOn:Transcript
+ "
! !
!Method class methodsFor:'binary storage'!