# HG changeset patch # User claus # Date 783307518 -3600 # Node ID 48061f8659aa2b9b239a52f9b4c4fd1feb6ec560 # Parent 82ba8d2e3569b7aeaec66ffeff84f6b89ef187f8 more queries diff -r 82ba8d2e3569 -r 48061f8659aa Method.st --- 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'!