Method.st
author Claus Gittinger <cg@exept.de>
Tue, 16 Jan 1996 20:11:19 +0100
changeset 872 af04035b443d
parent 829 fc386319f41c
child 877 63ebb325ed20
permissions -rw-r--r--
binary class storage support
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
    13
CompiledCode subclass:#Method
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    14
       instanceVariableNames:'source sourcePosition category package'
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
    15
       classVariableNames:'PrivateMethodSignal 
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
    16
			   LastFileReference LastSourceFileName
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
    17
			   LastWhoClass'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
       poolDictionaries:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
       category:'Kernel-Methods'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
42
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    22
!Method class methodsFor:'documentation'!
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    23
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    24
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    25
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    26
 COPYRIGHT (c) 1989 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    27
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    28
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    30
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    32
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
version
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
    39
    ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.66 1996-01-16 19:11:11 cg Exp $'
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
42
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    42
documentation
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    43
"
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    44
    this class defines protocol for executable methods;
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    45
    both compiled and interpreted methods are represented by this class.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    46
    Compiled methods have a non-nil code field, while interpreted methods have
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    47
    a nil code field and non-nil byteCode field.
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
    If there are both non-nil code and bytecode fields, the VM will execute
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    49
    the machine-code of a method. If both are nil when executed, a noByteCode
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    50
    message is sent by the VM to the method where a signal is raised.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    51
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    52
    The methods sourcecode is represented by source and sourcePosition:
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    53
    - if sourcePosition is a Number, the source-field is the fileName and
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    54
      sourcePosition is the character offset of the source-chunk in this source file.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    55
    - If sourcePosition is nil, the source is the string in the source field.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    56
    (an old version used ExternalString instances here, but that lead to
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    57
     10000 additional little objects ...)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    58
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    59
    The flags field defines things like the number of method-locals,
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    60
    method arguments and stack requirements (for interpreted methods).
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    61
    Do not depend on any value in the flags field - it may change without
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    62
    notice.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    63
438
claus
parents: 423
diff changeset
    64
    Notice, that in ST/X, method can be subclassed; executable code is
claus
parents: 423
diff changeset
    65
    identified not by being a subclass of Block or Method, but instead by
claus
parents: 423
diff changeset
    66
    having the executable flag bit set in the class. The VM can execute anything
claus
parents: 423
diff changeset
    67
    which is identified as executable (assuming that the first instance variable
claus
parents: 423
diff changeset
    68
    is the machine-code address) - this allows for easy future extension.
claus
parents: 423
diff changeset
    69
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    70
    Instance variables:
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    71
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    72
	source          <String>        the source itself (if sourcePosition isNil)
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    73
					or the fileName where the source is found
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    74
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    75
	sourcePosition  <Integer>       the position of the methods chunk in the file
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    76
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    77
	category        <Symbol>        the methods category
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    78
	package         <Symbol>        the package, in which the methods was defined
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    79
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    80
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    81
    Class variables:
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    82
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    83
	PrivateMethodSignal             raised on privacy violation (see docu)
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    84
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    85
	LastFileReference               weak reference to the last sourceFile
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    86
	LastSourceFileName              to speedup source access via NFS
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    87
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    88
    WARNING: layout known by compiler and runtime system - dont change
42
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    89
"
176
48061f8659aa more queries
claus
parents: 159
diff changeset
    90
!
48061f8659aa more queries
claus
parents: 159
diff changeset
    91
48061f8659aa more queries
claus
parents: 159
diff changeset
    92
privacy 
48061f8659aa more queries
claus
parents: 159
diff changeset
    93
"
48061f8659aa more queries
claus
parents: 159
diff changeset
    94
    ST/X includes an EXPERIMENTAL implementation of method privacy.
48061f8659aa more queries
claus
parents: 159
diff changeset
    95
    Individual methods may be set to private or protected via the
48061f8659aa more queries
claus
parents: 159
diff changeset
    96
    #setPrivate and #setProtected messages. Also, categories may be
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
    97
    filedIn as a whole as private using #privateMethodsFor: or as
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
    98
    protected using #protectedMethodsFor: instead of the well known #methodsFor:.
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
    99
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   100
    The additional #publicMethodsFor: is for documentation purposes, and
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   101
    is equivalent to #methodsFor: (also to support fileIn of ENVY methods).
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   102
48061f8659aa more queries
claus
parents: 159
diff changeset
   103
    Private methods may be executed only when called via a self or super-send
48061f8659aa more queries
claus
parents: 159
diff changeset
   104
    from the superclass, the class itself or subclasses.
415
claus
parents: 414
diff changeset
   105
    Protected methods may not be called from subclasses, i.e. they may only
claus
parents: 414
diff changeset
   106
    be called via self sends from within the current class.
claus
parents: 414
diff changeset
   107
    (i.e. private methods are less private than protected ones)
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   108
48061f8659aa more queries
claus
parents: 159
diff changeset
   109
    When such a situation arises, the VM (runtime system) will raise the
48061f8659aa more queries
claus
parents: 159
diff changeset
   110
    PrivateMethodSignal exception (if nonNil), which usually brings you into the
48061f8659aa more queries
claus
parents: 159
diff changeset
   111
    debugger.
48061f8659aa more queries
claus
parents: 159
diff changeset
   112
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   113
    If PrivateMethodSignal is nil, the VM will not check for this, and
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   114
    execution is as usual. (you may want to nil-it for production code,
48061f8659aa more queries
claus
parents: 159
diff changeset
   115
    and leave it non nil during development).
48061f8659aa more queries
claus
parents: 159
diff changeset
   116
48061f8659aa more queries
claus
parents: 159
diff changeset
   117
    NOTICE: there is no (not yet ?) standard defined for method privacy,
48061f8659aa more queries
claus
parents: 159
diff changeset
   118
    however, the interface was designed to be somewhat ENVY compatible (from
48061f8659aa more queries
claus
parents: 159
diff changeset
   119
    what can be deduced by reading PD code).
48061f8659aa more queries
claus
parents: 159
diff changeset
   120
    Also, the usability of privacy is still to be tested.
415
claus
parents: 414
diff changeset
   121
    This interface, the implementation and the rules for when a privacy violation
claus
parents: 414
diff changeset
   122
    may change (in case of some ANSI standard being defined).
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   123
    Be warned and send me suggestions & critics (constructive ;-)
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   124
"
438
claus
parents: 423
diff changeset
   125
!
claus
parents: 423
diff changeset
   126
claus
parents: 423
diff changeset
   127
dynamicMethods
claus
parents: 423
diff changeset
   128
"
claus
parents: 423
diff changeset
   129
    On systems which support dynamic loading of machine code (SYS5.4, Linux),
claus
parents: 423
diff changeset
   130
    methods may now be compiled to machine code from within the browser,
claus
parents: 423
diff changeset
   131
    and the resulting machine code object be loaded in.
claus
parents: 423
diff changeset
   132
    The ObjectFileLoader keeps (weak) handles to the resulting methods and
claus
parents: 423
diff changeset
   133
    invalidates the corresponding method objects, if the underlying methods
claus
parents: 423
diff changeset
   134
    object code is unloaded.
claus
parents: 423
diff changeset
   135
    Invalid methods will trap into the debugger when executed;
claus
parents: 423
diff changeset
   136
    also, the browser marks them as '(* not executable *)' in its method list.
claus
parents: 423
diff changeset
   137
"
42
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
   138
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   139
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   140
!Method class methodsFor:'initialization'!
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   141
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   142
initialize
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   143
    PrivateMethodSignal isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   144
	"EXPERIMENTAL"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   145
	PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   146
	PrivateMethodSignal nameClass:self message:#privateMethodSignal.
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   147
	PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   148
    ]
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   149
! !
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   150
345
claus
parents: 343
diff changeset
   151
!Method class methodsFor:'Signal constants'!
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   152
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   153
privateMethodSignal
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   154
    "return the signal raised when a private/protected method is called
48061f8659aa more queries
claus
parents: 159
diff changeset
   155
     by some other object (i.e. not a self- or super send)"
48061f8659aa more queries
claus
parents: 159
diff changeset
   156
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   157
    ^ PrivateMethodSignal
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   158
! !
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   159
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   160
!Method class methodsFor:'queries'!
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   161
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   162
isBuiltInClass
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   163
    "this class is known by the run-time-system"
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   164
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   165
    ^ self == Method
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   166
!
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   167
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   168
maxNumberOfArguments
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   169
    "this limit will be removed in one of the next versions ..."
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   170
423
claus
parents: 421
diff changeset
   171
    ^ 15  "cannot be easily changed; should ask the VM about this number"
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   172
!
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   173
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   174
methodPrivacySupported
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   175
    "return true, if the system was compiled to support methodPrivacy.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   176
     You should not depend on that feature being available."
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   177
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   178
%{  /* NOCONTEXT */
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   179
#if defined(F_PRIVATE) || defined(F_CLASSPRIVATE)
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   180
    RETURN (true);
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   181
#else
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   182
    RETURN (false);
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   183
#endif
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   184
%}
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   185
! !
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   186
571
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   187
!Method methodsFor:'copying'!
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   188
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   189
copy
572
271607405bb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 571
diff changeset
   190
    "redefined to change source ref into a real string"
271607405bb8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 571
diff changeset
   191
571
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   192
    |aCopy|
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   193
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   194
    aCopy := super copy.
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   195
    sourcePosition notNil ifTrue:[
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   196
	aCopy source:(self source)
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   197
    ].
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   198
    ^ aCopy
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   199
! !
401f90539673 copy method added
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   200
259
   201
!Method methodsFor:'queries'!
   202
   203
isMethod
   204
    "return true, if the receiver is some kind of method;
   205
     true returned here - the method is redefined from Object."
   206
   207
    ^ true
423
claus
parents: 421
diff changeset
   208
!
claus
parents: 421
diff changeset
   209
claus
parents: 421
diff changeset
   210
modificationTime
claus
parents: 421
diff changeset
   211
    "try to extract the modificationTime as a timeStamp from
claus
parents: 421
diff changeset
   212
     the receivers source. If there is no source or no history line, 
claus
parents: 421
diff changeset
   213
     we do not know the modification time, and nil is returned."
claus
parents: 421
diff changeset
   214
claus
parents: 421
diff changeset
   215
    |s list histLine|
claus
parents: 421
diff changeset
   216
claus
parents: 421
diff changeset
   217
    HistoryManager isNil ifTrue:[^ nil].
claus
parents: 421
diff changeset
   218
    s := self source.
claus
parents: 421
diff changeset
   219
    s isNil ifTrue:[^ nil].
claus
parents: 421
diff changeset
   220
    list := HistoryManager getAllHistoriesFrom:s.
claus
parents: 421
diff changeset
   221
    list size == 0 ifTrue:[^ nil].
claus
parents: 421
diff changeset
   222
    histLine := list last.
claus
parents: 421
diff changeset
   223
    ^ AbsoluteTime date:histLine date time:histLine time
claus
parents: 421
diff changeset
   224
claus
parents: 421
diff changeset
   225
    "
claus
parents: 421
diff changeset
   226
     (Method compiledMethodAt:#modificationTime) modificationTime
claus
parents: 421
diff changeset
   227
     (Method compiledMethodAt:#isMethod) modificationTime 
claus
parents: 421
diff changeset
   228
    "
claus
parents: 421
diff changeset
   229
claus
parents: 421
diff changeset
   230
    "Modified: 8.9.1995 / 15:08:22 / claus"
259
   231
! !
   232
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   233
!Method methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   234
a27a279701f8 Initial revision
claus
parents:
diff changeset
   235
source
a27a279701f8 Initial revision
claus
parents:
diff changeset
   236
    "return the sourcestring for the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   237
737
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   238
    |aStream fileName junk w myClass mgr className|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   239
a27a279701f8 Initial revision
claus
parents:
diff changeset
   240
    source notNil ifTrue:[
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   241
	"
48061f8659aa more queries
claus
parents: 159
diff changeset
   242
	 if sourcePosition is nonNil, its the fileName and
48061f8659aa more queries
claus
parents: 159
diff changeset
   243
	 sourcePosition is the offset.
48061f8659aa more queries
claus
parents: 159
diff changeset
   244
	 Otherwise, source is the real source
48061f8659aa more queries
claus
parents: 159
diff changeset
   245
	"
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   246
	sourcePosition isNil ifTrue:[^ source].
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   247
"/
625
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   248
"/ original (old) code:
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   249
"/
48061f8659aa more queries
claus
parents: 159
diff changeset
   250
"/        aStream := Smalltalk systemFileStreamFor:('source/' , source).
48061f8659aa more queries
claus
parents: 159
diff changeset
   251
"/        aStream notNil ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
   252
"/            aStream position:sourcePosition.
48061f8659aa more queries
claus
parents: 159
diff changeset
   253
"/            junk := aStream nextChunk.
48061f8659aa more queries
claus
parents: 159
diff changeset
   254
"/            aStream close
48061f8659aa more queries
claus
parents: 159
diff changeset
   255
"/        ]
48061f8659aa more queries
claus
parents: 159
diff changeset
   256
625
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   257
	"/ keep the last source file open, because open/close
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   258
	"/ operations maybe slow on NFS-mounted file systems.
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   259
	"/ Since the reference to the file is weak, it will be closed
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   260
	"/ automatically if the file is not referenced for a while. 
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   261
	"/ Neat trick.
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   262
48061f8659aa more queries
claus
parents: 159
diff changeset
   263
	LastSourceFileName = source ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
   264
	    aStream := LastFileReference at:1.
48061f8659aa more queries
claus
parents: 159
diff changeset
   265
	].
48061f8659aa more queries
claus
parents: 159
diff changeset
   266
48061f8659aa more queries
claus
parents: 159
diff changeset
   267
	aStream isNil ifTrue:[
625
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   268
	    "/
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   269
	    "/ if there is no SourceManager, look in standard places
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   270
	    "/ first
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   271
	    "/
690
b662a2173042 access SourceCodeManager via a class specific method
Claus Gittinger <cg@exept.de>
parents: 625
diff changeset
   272
	    (mgr := Smalltalk at:#SourceCodeManager) isNil ifTrue:[
625
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   273
		fileName := Smalltalk getSourceFileName:source.
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   274
		fileName notNil ifTrue:[
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   275
		    aStream := fileName asFilename readStream.
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   276
		].
192
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
   277
	    ].
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
   278
	    aStream isNil ifTrue:[
625
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   279
		"/
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   280
		"/ nope - ask my class for the source (this also invoces the SCMgr)
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   281
		"/
486
1e19564b2b5e prepare for CVS SourceCodeManager
Claus Gittinger <cg@exept.de>
parents: 463
diff changeset
   282
		w := self who.
1e19564b2b5e prepare for CVS SourceCodeManager
Claus Gittinger <cg@exept.de>
parents: 463
diff changeset
   283
		w notNil ifTrue:[
1e19564b2b5e prepare for CVS SourceCodeManager
Claus Gittinger <cg@exept.de>
parents: 463
diff changeset
   284
		    myClass := w at:1.
522
198bf04a3aa4 moved source-file access code into class
Claus Gittinger <cg@exept.de>
parents: 486
diff changeset
   285
		    aStream := myClass sourceStream.
486
1e19564b2b5e prepare for CVS SourceCodeManager
Claus Gittinger <cg@exept.de>
parents: 463
diff changeset
   286
		].
737
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   287
601
338404aae5ec take local source file as last chance only (in case of a fileOut,
Claus Gittinger <cg@exept.de>
parents: 572
diff changeset
   288
		aStream isNil ifTrue:[
737
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   289
		    "/
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   290
		    "/ nope - look in standard places 
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   291
		    "/ (if there is a source-code manager - otherwise, we already did that)
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   292
		    "/
690
b662a2173042 access SourceCodeManager via a class specific method
Claus Gittinger <cg@exept.de>
parents: 625
diff changeset
   293
		    mgr notNil ifTrue:[
625
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   294
			fileName := Smalltalk getSourceFileName:source.
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   295
			fileName notNil ifTrue:[
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   296
			    aStream := fileName asFilename readStream.
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   297
			]
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   298
		    ].
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   299
		    "/
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   300
		    "/ final chance: try current directory
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   301
		    "/
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   302
		    aStream isNil ifTrue:[
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   303
			aStream := source asFilename readStream.
5f45ffc4cdd4 if a SourceCodeManager is available, ask that one FIRST for the source,
Claus Gittinger <cg@exept.de>
parents: 601
diff changeset
   304
		    ]
601
338404aae5ec take local source file as last chance only (in case of a fileOut,
Claus Gittinger <cg@exept.de>
parents: 572
diff changeset
   305
		].
737
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   306
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   307
		(aStream isNil and:[w isNil and:[source notNil]]) ifTrue:[
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   308
		    "/
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   309
		    "/ mhmh - seems to be a method which used to be in some
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   310
		    "/ class, but has been overwritten by another or removed.
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   311
		    "/ (i.e. it has no containing class anyMore)
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   312
		    "/ try to guess the class from the sourceFileName.
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   313
		    "/ and retry.
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   314
		    "/
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   315
		    className := Smalltalk classNameForFile:source.
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   316
		    className knownAsSymbol ifTrue:[
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   317
			myClass := Smalltalk at:className asSymbol ifAbsent:nil.
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   318
			myClass notNil ifTrue:[
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   319
			    aStream := myClass sourceStream.
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   320
			]
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   321
		    ]
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   322
		]                
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
   323
	    ]
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   324
	].
48061f8659aa more queries
claus
parents: 159
diff changeset
   325
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   326
	aStream notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   327
	    aStream position:sourcePosition.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   328
	    junk := aStream nextChunk.
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   329
48061f8659aa more queries
claus
parents: 159
diff changeset
   330
	    "
737
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   331
	     keep a weak reference - it may be needed again soon ...
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   332
	    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   333
	    LastFileReference isNil ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
   334
		LastFileReference := WeakArray new:1
48061f8659aa more queries
claus
parents: 159
diff changeset
   335
	    ].
48061f8659aa more queries
claus
parents: 159
diff changeset
   336
	    LastFileReference at:1 put:aStream.
48061f8659aa more queries
claus
parents: 159
diff changeset
   337
	    LastSourceFileName := source
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   338
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   339
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   340
    ^ junk
486
1e19564b2b5e prepare for CVS SourceCodeManager
Claus Gittinger <cg@exept.de>
parents: 463
diff changeset
   341
737
4ed893ad3f0f try more to find source of obsolete methods
Claus Gittinger <cg@exept.de>
parents: 690
diff changeset
   342
    "Modified: 11.12.1995 / 14:53:40 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   343
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   344
a27a279701f8 Initial revision
claus
parents:
diff changeset
   345
source:aString
a27a279701f8 Initial revision
claus
parents:
diff changeset
   346
    "set the methods sourcestring"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   347
a27a279701f8 Initial revision
claus
parents:
diff changeset
   348
    source := aString.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   349
    sourcePosition := nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
   350
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   351
192
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
   352
sourceFilename
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   353
    "return the sourcefilename if source is extern; nil otherwise"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   354
a27a279701f8 Initial revision
claus
parents:
diff changeset
   355
    sourcePosition notNil ifTrue:[^ source].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   356
    ^ nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
   357
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   358
a27a279701f8 Initial revision
claus
parents:
diff changeset
   359
sourcePosition
a27a279701f8 Initial revision
claus
parents:
diff changeset
   360
    "return the sourceposition if source is extern; nil otherwise"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   361
a27a279701f8 Initial revision
claus
parents:
diff changeset
   362
    ^ sourcePosition
a27a279701f8 Initial revision
claus
parents:
diff changeset
   363
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   364
192
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
   365
sourceFilename:aFileName position:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   366
    "set the methods sourcefile/position"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   367
a27a279701f8 Initial revision
claus
parents:
diff changeset
   368
    source := aFileName.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   369
    sourcePosition := aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   370
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   371
39
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   372
comment
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   373
    "return the methods comment.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   374
     This is done by searching for and returning the first comment
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   375
     from the methods source (excluding any double-quotes). 
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   376
     Returns nil if there is no comment (or source is not available)."
39
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   377
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   378
    |src stream|
39
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   379
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   380
    src := self source.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   381
    src isNil ifTrue:[^ nil].
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   382
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   383
    stream := ReadStream on:src.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   384
    (stream skipThrough:Character doubleQuote) isNil ifTrue:[^ nil].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   385
    ^ stream upTo:Character doubleQuote.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   386
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   387
    "
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   388
     (Method compiledMethodAt:#comment) comment 
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   389
    "
39
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   390
!
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   391
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   392
category
a27a279701f8 Initial revision
claus
parents:
diff changeset
   393
    "return the methods category or nil"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   394
a27a279701f8 Initial revision
claus
parents:
diff changeset
   395
    ^ category
a27a279701f8 Initial revision
claus
parents:
diff changeset
   396
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   397
a27a279701f8 Initial revision
claus
parents:
diff changeset
   398
category:aStringOrSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   399
    "set the methods category"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   400
a27a279701f8 Initial revision
claus
parents:
diff changeset
   401
    category := aStringOrSymbol asSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   402
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   403
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   404
package
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   405
    "return the package-symbol"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   406
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   407
    ^ package
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   408
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   409
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   410
package:aSymbol
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   411
    "set the package-symbol"
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   412
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   413
    package := aSymbol
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   414
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   415
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   416
flags
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   417
    "return the flags (number of method variables, stacksize etc.).
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   418
     Dont depend on the values in the flag field - it may change
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   419
     without notice."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   420
a27a279701f8 Initial revision
claus
parents:
diff changeset
   421
    ^ flags
a27a279701f8 Initial revision
claus
parents:
diff changeset
   422
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   423
a27a279701f8 Initial revision
claus
parents:
diff changeset
   424
flags:newFlags
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   425
    "set the flags (number of method variables, stacksize).
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   426
     WARNING: for internal use by the compiler only."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   427
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   428
    "protect myself a bit - putting in an object would crash me ..."
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   429
    (newFlags isMemberOf:SmallInteger) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   430
	flags := newFlags
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   431
    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   432
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   433
414
claus
parents: 400
diff changeset
   434
privacy
claus
parents: 400
diff changeset
   435
    "return a symbol describing the methods access rights (privacy);
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   436
     Currently, this is one of #private, #protected, #public or #ignored.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   437
414
claus
parents: 400
diff changeset
   438
     Notice: method privacy is a nonstandard feature, not supported
claus
parents: 400
diff changeset
   439
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   440
     If at all, use it for debugging purposes, to catch messagesends
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   441
     which are not supposed to be sent by others.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   442
     (especially, if working in a team, while integrating other peoples work)
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   443
414
claus
parents: 400
diff changeset
   444
     This is EXPERIMENTAL - and being evaluated for usability.
claus
parents: 400
diff changeset
   445
     It may change or even vanish (if it shows to be not useful)."
claus
parents: 400
diff changeset
   446
claus
parents: 400
diff changeset
   447
    self isPrivate ifTrue:[^ #private].
claus
parents: 400
diff changeset
   448
    self isProtected ifTrue:[^ #protected].
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   449
    self isIgnored ifTrue:[^ #ignored].
414
claus
parents: 400
diff changeset
   450
    ^ #public
claus
parents: 400
diff changeset
   451
claus
parents: 400
diff changeset
   452
    "Modified: 27.8.1995 / 22:53:31 / claus"
claus
parents: 400
diff changeset
   453
!
claus
parents: 400
diff changeset
   454
claus
parents: 400
diff changeset
   455
privacy:aSymbol
claus
parents: 400
diff changeset
   456
    "set the methods access rights (privacy) from a symbol;
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   457
     Currently, this must be one of #private, #protected, #public or #ignored.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   458
414
claus
parents: 400
diff changeset
   459
     Notice: method privacy is a nonstandard feature, not supported
claus
parents: 400
diff changeset
   460
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   461
     If at all, use it for debugging purposes, to catch messagesends
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   462
     which are not supposed to be sent by others.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   463
     (especially, if working in a team, while integrating other peoples work)
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   464
414
claus
parents: 400
diff changeset
   465
     This is EXPERIMENTAL - and being evaluated for usability.
claus
parents: 400
diff changeset
   466
     It may change or even vanish (if it shows to be not useful)."
claus
parents: 400
diff changeset
   467
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   468
    aSymbol == #public ifTrue:[
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   469
	"/
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   470
	"/ no need to flush, if changing from private to public
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   471
	"/
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   472
	self isIgnored ifFalse:[
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   473
	    ^ self setToPublic
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   474
	].
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   475
	self setToPublic
415
claus
parents: 414
diff changeset
   476
    ] ifFalse:[
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   477
	aSymbol == #private ifTrue:[
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   478
	    self setToPrivate
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   479
	] ifFalse:[
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   480
	    aSymbol == #protected ifTrue:[
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   481
		self setToProtected
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   482
	    ] ifFalse:[
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   483
		aSymbol == #ignored ifTrue:[
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   484
		    self setToIgnored
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   485
		]
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   486
	    ]
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   487
	]
415
claus
parents: 414
diff changeset
   488
    ].
claus
parents: 414
diff changeset
   489
    ObjectMemory flushCaches.
414
claus
parents: 400
diff changeset
   490
claus
parents: 400
diff changeset
   491
    "Modified: 27.8.1995 / 22:58:08 / claus"
claus
parents: 400
diff changeset
   492
!
claus
parents: 400
diff changeset
   493
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   494
setToPrivate
48061f8659aa more queries
claus
parents: 159
diff changeset
   495
    "set the flag bit stating that this method is private. 
48061f8659aa more queries
claus
parents: 159
diff changeset
   496
     Execution of the receiver will only be allowed for self/super-sends from 
48061f8659aa more queries
claus
parents: 159
diff changeset
   497
     the class, superclasses or subclasses (or via #perform).
48061f8659aa more queries
claus
parents: 159
diff changeset
   498
     If a private method is called by some other class, a runtime
48061f8659aa more queries
claus
parents: 159
diff changeset
   499
     error (PrivateMethodSignal) is raised.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   500
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   501
     Notice: method privacy is a nonstandard feature, not supported
48061f8659aa more queries
claus
parents: 159
diff changeset
   502
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   503
     If at all, use it for debugging purposes, to catch messagesends
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   504
     which are not supposed to be sent by others.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   505
     (especially, if working in a team, while integrating other peoples work)
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   506
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   507
     This is EXPERIMENTAL - and being evaluated for usability.
48061f8659aa more queries
claus
parents: 159
diff changeset
   508
     It may change or even vanish (if it shows to be not useful)."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   509
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   510
%{  /* NOCONTEXT */
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   511
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   512
748
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
   513
#if defined(F_PRIVATE) && defined(M_PRIVACY)
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   514
    int f = _intVal(_INST(flags));
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   515
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   516
    f = (f & ~M_PRIVACY) | F_PRIVATE;
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   517
    _INST(flags) = _MKSMALLINT(f);
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   518
#endif
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   519
%}
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   520
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   521
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   522
setToProtected
48061f8659aa more queries
claus
parents: 159
diff changeset
   523
    "set the flag bit stating that this method is protected. 
48061f8659aa more queries
claus
parents: 159
diff changeset
   524
     Execution of the receiver will only be allowed for self sends from
48061f8659aa more queries
claus
parents: 159
diff changeset
   525
     the class or superclasses. (or via #perform).
48061f8659aa more queries
claus
parents: 159
diff changeset
   526
     If a private method is called by some other class, a runtime
48061f8659aa more queries
claus
parents: 159
diff changeset
   527
     error (PrivateMethodSignal) is raised.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   528
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   529
     Notice: method privacy is a nonstandard feature, not supported
48061f8659aa more queries
claus
parents: 159
diff changeset
   530
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   531
     If at all, use it for debugging purposes, to catch messagesends
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   532
     which are not supposed to be sent by others.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   533
     (especially, if working in a team, while integrating other peoples work)
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   534
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   535
     This is EXPERIMENTAL - and being evaluated for usability.
48061f8659aa more queries
claus
parents: 159
diff changeset
   536
     It may change or even vanish (if it shows to be not useful)."
48061f8659aa more queries
claus
parents: 159
diff changeset
   537
48061f8659aa more queries
claus
parents: 159
diff changeset
   538
%{  /* NOCONTEXT */
48061f8659aa more queries
claus
parents: 159
diff changeset
   539
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   540
748
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
   541
#if defined(F_CLASSPRIVATE) && defined(M_PRIVACY)
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   542
    int f = _intVal(_INST(flags));
48061f8659aa more queries
claus
parents: 159
diff changeset
   543
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   544
    f = (f & ~M_PRIVACY) | F_CLASSPRIVATE;
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   545
    _INST(flags) = _MKSMALLINT(f);
48061f8659aa more queries
claus
parents: 159
diff changeset
   546
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   547
%}
48061f8659aa more queries
claus
parents: 159
diff changeset
   548
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   549
48061f8659aa more queries
claus
parents: 159
diff changeset
   550
setToPublic
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   551
    "clear any privacy/ignoreFlag of the receiver. 
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   552
     The receiver may be executed by any send. 
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   553
     This is the default anyway for methods, and how other smalltalk
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   554
     implementations treat all methods.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   555
360
claus
parents: 350
diff changeset
   556
     Notice: method privacy is a nonstandard feature, not supported
claus
parents: 350
diff changeset
   557
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   558
     If at all, use it for debugging purposes, to catch messagesends
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   559
     which are not supposed to be sent by others.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   560
     (especially, if working in a team, while integrating other peoples work)
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   561
360
claus
parents: 350
diff changeset
   562
     This is EXPERIMENTAL - and being evaluated for usability.
claus
parents: 350
diff changeset
   563
     It may change or even vanish (if it shows to be not useful)."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   564
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   565
%{  /* NOCONTEXT */
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   566
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   567
748
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
   568
#ifdef M_PRIVACY
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   569
    int f = _intVal(_INST(flags));
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   570
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   571
    f = f & ~M_PRIVACY;
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   572
    _INST(flags) = _MKSMALLINT(f);
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   573
#endif
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   574
%}
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   575
!
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   576
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   577
setToIgnored
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   578
    "make this method be ignored w.r.t. method lookup.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   579
     (i.e. setting a method to #ignored, and sending that selector,
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   580
      leads to either the superclasses implementation to be called, 
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   581
      or a doesNotUnderstand exception to be raised)
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   582
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   583
     Notice: ignored methods are a nonstandard feature, not supported
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   584
     by other smalltalk implementations and not specified in the ANSI spec.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   585
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   586
     This is EXPERIMENTAL - and being evaluated for usability.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   587
     It may change or even vanish (if it shows to be not useful)."
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   588
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   589
%{  /* NOCONTEXT */
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   590
    int f = _intVal(_INST(flags));
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   591
748
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
   592
#if defined(F_IGNORED) && defined(M_PRIVACY)
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   593
    f = (f & ~M_PRIVACY) | F_IGNORED;
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   594
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   595
    _INST(flags) = _MKSMALLINT(f);
48061f8659aa more queries
claus
parents: 159
diff changeset
   596
%}
48061f8659aa more queries
claus
parents: 159
diff changeset
   597
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   598
48061f8659aa more queries
claus
parents: 159
diff changeset
   599
isPrivate
48061f8659aa more queries
claus
parents: 159
diff changeset
   600
    "return true, if this is a private method.
48061f8659aa more queries
claus
parents: 159
diff changeset
   601
     Execution of private methods is only allowed via self/super sends
48061f8659aa more queries
claus
parents: 159
diff changeset
   602
     from superclasses, the class itself or subclasses.
48061f8659aa more queries
claus
parents: 159
diff changeset
   603
     If a private method is called by some other class, a runtime
48061f8659aa more queries
claus
parents: 159
diff changeset
   604
     error (PrivateMethodSignal) is raised.
48061f8659aa more queries
claus
parents: 159
diff changeset
   605
     Notice: method privacy is a nonstandard feature, not supported
48061f8659aa more queries
claus
parents: 159
diff changeset
   606
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   607
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   608
     This is EXPERIMENTAL - and being evaluated for usability.
48061f8659aa more queries
claus
parents: 159
diff changeset
   609
     It may change or even vanish (if it shows to be not useful)."
48061f8659aa more queries
claus
parents: 159
diff changeset
   610
48061f8659aa more queries
claus
parents: 159
diff changeset
   611
%{  /* NOCONTEXT */
48061f8659aa more queries
claus
parents: 159
diff changeset
   612
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   613
748
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
   614
#if defined(F_PRIVATE) && defined(M_PRIVACY)
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   615
    int f = _intVal(_INST(flags));
48061f8659aa more queries
claus
parents: 159
diff changeset
   616
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   617
    if ((f & M_PRIVACY) == F_PRIVATE) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   618
	RETURN (true);
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   619
    }
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   620
#endif
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   621
%}.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   622
    ^ false
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   623
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   624
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   625
isProtected
48061f8659aa more queries
claus
parents: 159
diff changeset
   626
    "return true, if this is a protected method.
48061f8659aa more queries
claus
parents: 159
diff changeset
   627
     Execution of protected methods is only allowed via self sends
48061f8659aa more queries
claus
parents: 159
diff changeset
   628
     from superclasses or the class itself.
48061f8659aa more queries
claus
parents: 159
diff changeset
   629
     If a protected method is called by some other class, a runtime
48061f8659aa more queries
claus
parents: 159
diff changeset
   630
     error (PrivateMethodSignal) is raised.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   631
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   632
     Notice: method privacy is a nonstandard feature, not supported
48061f8659aa more queries
claus
parents: 159
diff changeset
   633
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   634
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   635
     This is EXPERIMENTAL - and being evaluated for usability.
48061f8659aa more queries
claus
parents: 159
diff changeset
   636
     It may change or even vanish (if it shows to be not useful)."
48061f8659aa more queries
claus
parents: 159
diff changeset
   637
48061f8659aa more queries
claus
parents: 159
diff changeset
   638
%{  /* NOCONTEXT */
48061f8659aa more queries
claus
parents: 159
diff changeset
   639
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   640
748
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
   641
#if defined(F_CLASSPRIVATE) && defined(M_PRIVACY)
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   642
    int f = _intVal(_INST(flags));
48061f8659aa more queries
claus
parents: 159
diff changeset
   643
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   644
    if ((f & M_PRIVACY) == F_CLASSPRIVATE) {
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   645
	RETURN (true);
48061f8659aa more queries
claus
parents: 159
diff changeset
   646
    }
48061f8659aa more queries
claus
parents: 159
diff changeset
   647
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   648
%}.
48061f8659aa more queries
claus
parents: 159
diff changeset
   649
    ^ false
48061f8659aa more queries
claus
parents: 159
diff changeset
   650
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   651
48061f8659aa more queries
claus
parents: 159
diff changeset
   652
isPublic
48061f8659aa more queries
claus
parents: 159
diff changeset
   653
    "return true, if this is a public method - I.e. can be executed via any send.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   654
     This is the default and how other smalltalk implementations treat all methods.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   655
360
claus
parents: 350
diff changeset
   656
     Notice: method privacy is a nonstandard feature, not supported
claus
parents: 350
diff changeset
   657
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   658
360
claus
parents: 350
diff changeset
   659
     This is EXPERIMENTAL - and being evaluated for usability.
claus
parents: 350
diff changeset
   660
     It may change or even vanish (if it shows to be not useful)."
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   661
48061f8659aa more queries
claus
parents: 159
diff changeset
   662
%{  /* NOCONTEXT */
48061f8659aa more queries
claus
parents: 159
diff changeset
   663
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   664
748
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
   665
#if defined(M_PRIVACY) && (defined(F_PRIVATE) || defined(F_CLASSPRIVATE) || defined(F_IGNORED))
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   666
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   667
    int f = _intVal(_INST(flags));
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   668
# ifdef F_PRIVATE
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   669
    if ((f & M_PRIVACY) == F_PRIVATE) {
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   670
	RETURN (false);
48061f8659aa more queries
claus
parents: 159
diff changeset
   671
    }
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   672
# endif
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   673
# ifdef F_CLASSPRIVATE
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   674
    if ((f & M_PRIVACY) == F_CLASSPRIVATE) {
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   675
	RETURN (false);
48061f8659aa more queries
claus
parents: 159
diff changeset
   676
    }
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   677
# endif
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   678
# ifdef F_IGNORED
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   679
    if ((f & M_PRIVACY) == F_IGNORED) {
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   680
	RETURN (false);
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   681
    }
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   682
# endif
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   683
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   684
%}.
48061f8659aa more queries
claus
parents: 159
diff changeset
   685
    ^ true
48061f8659aa more queries
claus
parents: 159
diff changeset
   686
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   687
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   688
isIgnored
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   689
    "return true, if this is an ignored method.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   690
     Ignored methods are physically present in the source file,
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   691
     but no code is generated for it by stc, and the VM does not see
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   692
     it in its message lookup.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   693
     (i.e. setting a method to #ignored, and sending that selector,
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   694
      leads to either the superclasses implementation to be called, 
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   695
      or a doesNotUnderstand exception to be raised)
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   696
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   697
     Notice: this is a nonstandard feature, not supported
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   698
     by other smalltalk implementations and not specified in the ANSI spec.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   699
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   700
     This is EXPERIMENTAL - and being evaluated for usability.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   701
     It may change or even vanish (if it shows to be not useful)."
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   702
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   703
%{  /* NOCONTEXT */
748
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
   704
#if defined(F_IGNORED) && defined(M_PRIVACY)
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   705
    int f = _intVal(_INST(flags));
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   706
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   707
    if ((f & M_PRIVACY) == F_IGNORED) {
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   708
	RETURN (true);
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   709
    }
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   710
#endif
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   711
%}.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   712
    ^ false
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   713
!
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   714
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   715
isRestricted
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   716
    "return the flag bit stating that this method is restricted.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   717
     Execution of the receiver will only be allowed if the system is not in
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   718
     'trap restricted mode' (-->ObjectMemory) otherise a runtime 
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   719
     error (PrivateMethodSignal) is raised.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   720
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   721
     Notice: method restriction is a nonstandard feature, not supported
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   722
     by other smalltalk implementations and not specified in the ANSI spec.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   723
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   724
     This is EXPERIMENTAL - and being evaluated for usability.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   725
     It may change or even vanish (if it shows to be not useful)."
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   726
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   727
%{  /* NOCONTEXT */
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   728
#ifdef F_RESTRICTED
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   729
    int f = _intVal(_INST(flags));
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   730
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   731
    if (f & F_RESTRICTED) {
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   732
	RETURN (true);
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   733
    }
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   734
#endif
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   735
%}.
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   736
    ^ false
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   737
! 
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   738
532
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   739
restricted:aBoolean
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   740
    "set or clear the flag bit stating that this method is restricted. 
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   741
     Execution of the receiver will only be allowed if the system is not in
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   742
     'trap restricted mode' (-->ObjectMemory) otherise a runtime
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   743
     error (PrivateMethodSignal) is raised.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   744
532
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   745
     Notice: method restriction is a nonstandard feature, not supported
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   746
     by other smalltalk implementations and not specified in the ANSI spec.
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   747
532
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   748
     This is EXPERIMENTAL - and being evaluated for usability.
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   749
     It may change or even vanish (if it shows to be not useful)."
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   750
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   751
%{  /* NOCONTEXT */
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   752
    /* I made this a primitive to get the define constant from stc.h */
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   753
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   754
#ifdef F_RESTRICTED
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   755
    int f = _intVal(_INST(flags));
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   756
    int old;
532
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   757
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   758
    old = f;
532
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   759
    if (aBoolean == true) 
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   760
	f |= F_RESTRICTED;
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   761
    else
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   762
	f &= ~F_RESTRICTED;
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   763
    _INST(flags) = _MKSMALLINT(f);
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   764
    if (old & F_RESTRICTED)
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   765
	RETURN(true);
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   766
#endif
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   767
%}.
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   768
    ^ false
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   769
747
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   770
    "
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   771
     (ObjectMemory class compiledMethodAt:#compressingGarbageCollect) restricted:true
ea3b6f7fd7ce added ignoredMethods
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   772
    "
532
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   773
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   774
    "Created: 7.11.1995 / 20:36:19 / stefan"
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   775
!
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   776
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   777
numberOfMethodArgs:aNumber
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   778
    "currently, the number of arguments is NOT remembered in
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   779
     methods, but this will be added soon to allow for more checking
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   780
     in #perform:.
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   781
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   782
     The limitation in the max. number of arguments is due to the
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   783
     missing SENDxx functions in the VM and cases in #perform. This too 
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   784
     will be removed in a later release, allowing any number of arguments.
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   785
     - for use by compiler only."
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   786
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   787
    (aNumber between:0 and:self class maxNumberOfArguments) ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   788
	self error:('ST/X only supports up to a maximum of ' ,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   789
		    self class maxNumberOfArguments printString ,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   790
		    ' method arguments').
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   791
	^ self
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   792
    ].
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   793
%{
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   794
    /* made this a primitive to get define in stc.h */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   795
#ifdef F_NARGS
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   796
    _INST(flags) = _MKSMALLINT( (_intVal(_INST(flags)) & ~F_NARGS) | (_intVal(aNumber) << F_NARGSHIFT) );
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   797
#endif
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   798
%}
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   799
!
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   800
     
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   801
numberOfMethodArgs
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   802
    "return the number of arguments, the method expects." 
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   803
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   804
%{  /* NOCONTEXT */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   805
    /* made this a primitive to get define in stc.h */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   806
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   807
#ifdef F_NARGS
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   808
    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NARGS) >> F_NARGSHIFT));
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   809
#endif
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   810
%}
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   811
.
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   812
    "
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   813
     The old implementation simply counted the arguments from
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   814
     the methods source - new versions include this information
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   815
     in the flag instVar, for more security in #perform:
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   816
    "
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   817
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   818
    ^ self methodArgNames size
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   819
!
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   820
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   821
numberOfMethodVars:aNumber
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   822
    "set the number of method variables - for use by compiler only.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   823
     WARNING: playing around here with incorrect values 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   824
	      may crash smalltalk badly."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   825
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   826
%{  /* NOCONTEXT */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   827
    int f = _intVal(_INST(flags));
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   828
a27a279701f8 Initial revision
claus
parents:
diff changeset
   829
    /* made this a primitive to get define in stc.h */
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
   830
    if (__isSmallInteger(aNumber)) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   831
	f = (f & ~F_NVARS) | (_intVal(aNumber) << F_NVARSHIFT);
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   832
	_INST(flags) = _MKSMALLINT(f);
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   833
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   834
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   835
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   836
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   837
numberOfMethodVars
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   838
    "return the number of method local variables. 
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   839
     Do not depend on the returned value - future optimizations
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   840
     may change things here (i.e. when moving block-locals into
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   841
     surrounding method for inlining).
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   842
     - for debugging only."
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   843
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   844
%{  /* NOCONTEXT */
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   845
    /* made this a primitive to get define in stc.h */
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   846
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   847
    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NVARS) >> F_NVARSHIFT));
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   848
%}
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   849
!
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   850
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   851
stackSize:aNumber
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   852
    "set the depth of the local stack - for use by compiler only.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   853
     WARNING: playing around here with incorrect values 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   854
	      may crash smalltalk badly.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   855
	      (if the runtime library was compiled with DEBUG, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   856
	       a bad stack will be detected and triggers an error)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   857
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   858
%{  /* NOCONTEXT */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   859
    int f = _intVal(_INST(flags));
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   860
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   861
    /* made this a primitive to get define in stc.h */
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
   862
    if (__isSmallInteger(aNumber)) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   863
	f = (f & ~F_NSTACK) | (_intVal(aNumber) << F_NSTACKSHIFT);
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   864
	_INST(flags) = _MKSMALLINT(f);
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   865
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   866
%}
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   867
!
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   868
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   869
stackSize
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   870
    "return the number of temporaries needed as stack in the context. 
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   871
     Do not depend on the returned value - future optimizations
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   872
     may change things here.
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   873
     - for debugging only."
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   874
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   875
%{  /* NOCONTEXT */
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   876
    /* made this a primitive to get define in stc.h */
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   877
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   878
    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NSTACK) >> F_NSTACKSHIFT));
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   879
%}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   880
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   881
a27a279701f8 Initial revision
claus
parents:
diff changeset
   882
!Method methodsFor:'queries'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   883
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   884
who
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   885
    "return the class and selector of where I am defined in. 
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   886
     Since there is no information of the containing class 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   887
     in the method, we have to do a search here.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   888
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   889
     Normally, this is not a problem, except when a method is
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   890
     accepted in the debugger or redefined from within a method
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   891
     (maybe done indirectly, if doIt is done recursively)
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   892
     - the information about which class the original method was 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   893
     defined in is lost in this case.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   894
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   895
     Problem: this is heavily called for in the debugger to create
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   896
	      a readable context walkback. For unbound methods, it is
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   897
	      slow, since the search (over all classes) will always fail.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   898
     Q: should we add a backref from the method to the class 
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   899
	and/or add a subclass of Method for unbound ones ?"
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   900
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   901
    |classes cls sel|
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   902
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   903
    "
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   904
     very first, look in the class we found something the last time
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   905
     this may often give a hit, when asking who repeatingly for
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   906
     a context chain. (keep last by its name, to not keep classes from
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   907
     being garbage collected)
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   908
    "
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   909
    LastWhoClass notNil ifTrue:[
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   910
	cls := Smalltalk at:LastWhoClass.
308
f04744ef7b5d *** empty log message ***
claus
parents: 307
diff changeset
   911
	cls notNil ifTrue:[
328
claus
parents: 326
diff changeset
   912
	    sel := cls selectorAtMethod:self.
308
f04744ef7b5d *** empty log message ***
claus
parents: 307
diff changeset
   913
	    sel notNil ifTrue:[^ Array with:cls with:sel].
f04744ef7b5d *** empty log message ***
claus
parents: 307
diff changeset
   914
	]
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   915
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   916
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   917
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   918
     first, limit the search to global classes only - 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   919
     since probability is high, that the receiver is found in there ...
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   920
    "
307
cc8fa75c8685 *** empty log message ***
claus
parents: 306
diff changeset
   921
    classes := Smalltalk allClasses.
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   922
    "
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   923
     instance methods are usually more common - search those first
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   924
    "
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   925
    classes do:[:aClass |
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   926
	|sel|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   927
328
claus
parents: 326
diff changeset
   928
	sel := aClass selectorAtMethod:self.
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   929
	sel notNil ifTrue:[LastWhoClass := aClass name.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   930
			   ^ Array with:aClass with:sel].
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   931
    ].
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   932
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   933
    LastWhoClass := nil.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   934
    classes do:[:aClass |
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   935
	|sel|
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   936
328
claus
parents: 326
diff changeset
   937
	sel := aClass class selectorAtMethod:self.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   938
	sel notNil ifTrue:[^ Array with:aClass class with:sel].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   939
    ].
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   940
    "
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   941
     mhmh - must be a method of some anonymous class (i.e. one not
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   942
     in the Smalltalk dictionary). Search all instances of Behavior
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   943
    "
328
claus
parents: 326
diff changeset
   944
    Behavior allSubInstancesDo:[:someClass |
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   945
	|sel|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   946
328
claus
parents: 326
diff changeset
   947
	sel := someClass selectorAtMethod:self.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   948
	sel notNil ifTrue:[^ Array with:someClass with:sel]
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   949
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   950
    "
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   951
     none found - sorry
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   952
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   953
    ^ nil
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   954
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   955
    "typical situation: some well-known class"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   956
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   957
     |m|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   958
     m := Object compiledMethodAt:#copy.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   959
     m who
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   960
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   961
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   962
    "untypical situation: an anonymous class"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   963
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   964
     |m cls|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   965
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   966
     Object 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   967
	subclass:#FunnyClass 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   968
	instanceVariableNames:'foo'
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   969
	classVariableNames:''
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   970
	poolDictionaries:''
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   971
	category:'testing'.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   972
     cls := Smalltalk at:#FunnyClass.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   973
     Smalltalk removeClass:cls.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   974
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   975
     cls compile:'testMethod1:arg foo:=arg'.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   976
     cls compile:'testMethod2 ^ foo'.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   977
     m := cls compiledMethodAt:#testMethod1:.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   978
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   979
     m who
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   980
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   981
!
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   982
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   983
containingClass
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   984
    "return the class I am defined in. 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   985
     See comment in who."
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   986
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   987
    "based on who, which has been added for ST-80 compatibility"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   988
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   989
    |pair|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   990
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   991
    pair := self who.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   992
    pair notNil ifTrue:[^ pair at:1].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   993
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   994
     none found - sorry
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   995
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   996
    ^ nil
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   997
48061f8659aa more queries
claus
parents: 159
diff changeset
   998
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   999
     |m|
48061f8659aa more queries
claus
parents: 159
diff changeset
  1000
     m := Object compiledMethodAt:#at:.
48061f8659aa more queries
claus
parents: 159
diff changeset
  1001
     m containingClass
48061f8659aa more queries
claus
parents: 159
diff changeset
  1002
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
  1003
!
48061f8659aa more queries
claus
parents: 159
diff changeset
  1004
48061f8659aa more queries
claus
parents: 159
diff changeset
  1005
selector
48061f8659aa more queries
claus
parents: 159
diff changeset
  1006
    "return the selector under which I am found in my containingClasses
48061f8659aa more queries
claus
parents: 159
diff changeset
  1007
     method-table. 
48061f8659aa more queries
claus
parents: 159
diff changeset
  1008
     See comment in who."
48061f8659aa more queries
claus
parents: 159
diff changeset
  1009
48061f8659aa more queries
claus
parents: 159
diff changeset
  1010
    "based on who, which has been added for ST-80 compatibility"
48061f8659aa more queries
claus
parents: 159
diff changeset
  1011
48061f8659aa more queries
claus
parents: 159
diff changeset
  1012
    |pair|
48061f8659aa more queries
claus
parents: 159
diff changeset
  1013
48061f8659aa more queries
claus
parents: 159
diff changeset
  1014
    pair := self who.
48061f8659aa more queries
claus
parents: 159
diff changeset
  1015
    pair notNil ifTrue:[^ pair at:2].
48061f8659aa more queries
claus
parents: 159
diff changeset
  1016
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
  1017
     none found - sorry
48061f8659aa more queries
claus
parents: 159
diff changeset
  1018
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
  1019
    ^ nil
48061f8659aa more queries
claus
parents: 159
diff changeset
  1020
48061f8659aa more queries
claus
parents: 159
diff changeset
  1021
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
  1022
     |m|
48061f8659aa more queries
claus
parents: 159
diff changeset
  1023
     m := Object compiledMethodAt:#at:.
48061f8659aa more queries
claus
parents: 159
diff changeset
  1024
     m selector
48061f8659aa more queries
claus
parents: 159
diff changeset
  1025
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1026
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1027
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1028
parse:parseSelector return:accessSelector or:valueIfNoSource 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1029
    "helper for methodArgNames, methodVarNames etc.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1030
     Get the source, let parser parse it using parseSelector,
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1031
     return parser info using accessSelector"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1032
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1033
    |parser sourceString|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1034
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1035
    sourceString := self source.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1036
    sourceString notNil ifTrue:[
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1037
	parser := Parser perform:parseSelector with:sourceString.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1038
	(parser isNil or:[parser == #Error]) ifTrue:[^ nil].
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1039
	^ parser perform:accessSelector
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1040
    ].
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1041
    ^ valueIfNoSource 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1042
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1043
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1044
methodArgNames
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1045
    "return a collection with the methods argument names.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1046
     Uses Parser to parse methods source and extract the names."
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1047
463
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1048
    ^ self parse:#'parseMethodSpecificationSilent:' return:#methodArgs or:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1049
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1050
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1051
     (Method compiledMethodAt:#printOn:) methodArgNames
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1052
    "
463
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1053
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1054
    "Modified: 31.10.1995 / 14:36:46 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1055
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1056
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1057
methodVarNames
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1058
    "return a collection with the methods local-variable names.
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1059
     Uses Parser to parse methods source and extract the names."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1060
463
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1061
    ^ self parse:#'parseMethodArgAndVarSpecificationSilent:' return:#methodVars or:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1062
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1063
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1064
     (Method compiledMethodAt:#printOn:) methodVarNames
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1065
    "
463
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1066
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1067
    "Modified: 31.10.1995 / 14:36:49 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1068
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1069
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1070
hasPrimitiveCode
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1071
    "return true, if the method contains primitive code; false if not.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1072
     Uses Parser to parse methods source and get the information."
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1073
463
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1074
    |src|
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1075
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1076
    src := self source.
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1077
    src notNil ifTrue:[
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1078
	(src includesString:'%{' ) ifFalse:[
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1079
	    "/ cannot contain primitive code.
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1080
	    ^ false
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1081
	]
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1082
    ].
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1083
    ^ self parse:#'parseMethodSilent:' return:#hasPrimitiveCode or:false
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1084
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1085
    "
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1086
     (Method compiledMethodAt:#hasPrimitiveCode) hasPrimitiveCode 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1087
     (Object compiledMethodAt:#at:) hasPrimitiveCode   
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1088
     (Object compiledMethodAt:#basicAt:) hasPrimitiveCode 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1089
    "
463
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1090
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1091
    "Modified: 31.10.1995 / 14:43:37 / cg"
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1092
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1093
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1094
methodArgAndVarNames
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1095
    "return a collection with the methods argument and variable names.
463
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1096
     Uses Parser to parse methods source and extract the names.
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1097
     Returns nil if the source is not available, or some other
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1098
     syntax/parse error occurred. For methods with no args and no vars,
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1099
     an empty collection is returned."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1100
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1101
    |parser sourceString argNames varNames|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1102
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1103
    sourceString := self source.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1104
    sourceString notNil ifTrue:[
463
447ead9f870c be silent on transcript when parsing for args, vars and primitiveCode
Claus Gittinger <cg@exept.de>
parents: 444
diff changeset
  1105
	parser := Parser parseMethodArgAndVarSpecificationSilent:sourceString.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1106
	(parser isNil or:[parser == #Error]) ifTrue:[^ nil].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1107
	argNames := parser methodArgs.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1108
	varNames := parser methodVars.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1109
	argNames isNil ifTrue:[^ varNames].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1110
	varNames isNil ifTrue:[^ argNames].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1111
	^ (argNames , varNames)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1112
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1113
    ^ nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1114
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1115
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1116
     (Method compiledMethodAt:#printOn:) methodArgAndVarNames
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1117
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1118
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1119
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1120
methodComment
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1121
    "return the methods first comment, nil if there is none.
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1122
     This is a somewhat stupid implementation."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1123
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1124
    |text line nQuote index qIndex qIndex2 comment|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1125
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1126
    text := self source asCollectionOfLines.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1127
    (text size < 2) ifTrue:[^nil].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1128
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1129
    line := (text at:2).
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1130
    nQuote := line occurrencesOf:(Character doubleQuote).
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1131
    (nQuote == 2) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1132
	qIndex := line indexOf:(Character doubleQuote).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1133
	qIndex2 := line indexOf:(Character doubleQuote) startingAt:(qIndex + 1).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1134
	^ line copyFrom:(qIndex + 1) to:(qIndex2 - 1)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1135
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1136
    (nQuote == 1) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1137
	qIndex := line indexOf:(Character doubleQuote).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1138
	comment := line copyFrom:(qIndex + 1).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1139
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1140
	index := 3.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1141
	line := text at:index.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1142
	nQuote := line occurrencesOf:(Character doubleQuote).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1143
	[nQuote ~~ 1] whileTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1144
	    comment := comment , Character cr asString , line withoutSpaces.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1145
	    index := index + 1.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1146
	    line := text at:index.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1147
	    nQuote := line occurrencesOf:(Character doubleQuote)
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1148
	].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1149
	qIndex := line indexOf:(Character doubleQuote).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1150
	^ comment , Character cr asString , (line copyTo:(qIndex - 1)) withoutSpaces
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1151
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1152
    ^ nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1153
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1154
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1155
     (Method compiledMethodAt:#methodComment) methodComment
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1156
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1157
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1158
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1159
referencesGlobal:aGlobalSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1160
    "return true, if this method references the global
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1161
     bound to aGlobalSymbol."
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1162
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1163
    literals isNil ifTrue:[^ false].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1164
    ^ (literals identityIndexOf:aGlobalSymbol startingAt:1) ~~ 0
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1165
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1166
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1167
sends:aSelectorSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1168
    "return true, if this method contains a message-send
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1169
     with aSelectorSymbol as selector. 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1170
     - due to the simple check in the literal array, also simple uses 
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1171
       of aSelectorSymbol as symbol will return true.
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1172
       Should ask compiler, if there is really a send."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1173
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1174
    ^ self referencesGlobal:aSelectorSymbol
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1175
!
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1176
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1177
isLazyMethod
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1178
    "return true, if this is a lazy method.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1179
     False is returned here - this method is redefined in LazyMethod"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1180
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1181
    ^ false
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1182
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1183
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1184
isWrapped
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1185
    "return true, if this is a wrapper method.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1186
     False is returned here - this method is redefined in WrappedMethod"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1187
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1188
    ^ false
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1189
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1190
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1191
wrapper
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1192
    "only for wrapped methods: return the wrapper.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1193
     Thats the WrapperMethod which contains myself."
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1194
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1195
    WrappedMethod allInstancesDo:[:m |
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1196
	m originalMethod == self ifTrue:[^ m].
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1197
    ].
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1198
    ^ nil
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1199
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1200
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1201
isInvalid
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1202
    "return true, if this method is not executable due to
328
claus
parents: 326
diff changeset
  1203
     a (re)-compilation error. (see comment in Method>>invalidCodeObject)"
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1204
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1205
    |m|
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1206
328
claus
parents: 326
diff changeset
  1207
    m := Method compiledMethodAt:#invalidCodeObject.
391
claus
parents: 384
diff changeset
  1208
    self ~~ m ifTrue:[
claus
parents: 384
diff changeset
  1209
	(self code notNil and:[self code = m code]) ifTrue:[^ true].
claus
parents: 384
diff changeset
  1210
	(byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
claus
parents: 384
diff changeset
  1211
    ].
362
claus
parents: 360
diff changeset
  1212
375
claus
parents: 362
diff changeset
  1213
    m := Method compiledMethodAt:#uncompiledCodeObject.
391
claus
parents: 384
diff changeset
  1214
    self ~~ m ifTrue:[
claus
parents: 384
diff changeset
  1215
	(self code notNil and:[self code = m code]) ifTrue:[^ true].
claus
parents: 384
diff changeset
  1216
	(byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
claus
parents: 384
diff changeset
  1217
    ].
362
claus
parents: 360
diff changeset
  1218
    m := Metaclass compiledMethodAt:#invalidCodeObject.
391
claus
parents: 384
diff changeset
  1219
    self ~~ m ifTrue:[
claus
parents: 384
diff changeset
  1220
	(self code notNil and:[self code = m code]) ifTrue:[^ true].
claus
parents: 384
diff changeset
  1221
	(byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
claus
parents: 384
diff changeset
  1222
    ].
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1223
    ^ false
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1224
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1225
438
claus
parents: 423
diff changeset
  1226
!Method methodsFor:'trap methods'!
claus
parents: 423
diff changeset
  1227
claus
parents: 423
diff changeset
  1228
makeInvalid
claus
parents: 423
diff changeset
  1229
    "make the receiver an invalid method, which raises an invalidCodeObject
claus
parents: 423
diff changeset
  1230
     signal when executed. This is not for public use - it is required for
claus
parents: 423
diff changeset
  1231
     the objectFileLoader to invalidate methods whose code is unloaded."
claus
parents: 423
diff changeset
  1232
claus
parents: 423
diff changeset
  1233
    |invldMethod|
claus
parents: 423
diff changeset
  1234
claus
parents: 423
diff changeset
  1235
    invldMethod := self class compiledMethodAt:#invalidCodeObject.
claus
parents: 423
diff changeset
  1236
    self code:invldMethod code.
claus
parents: 423
diff changeset
  1237
    self byteCode:invldMethod byteCode.
claus
parents: 423
diff changeset
  1238
claus
parents: 423
diff changeset
  1239
    "Created: 17.9.1995 / 15:00:52 / claus"
claus
parents: 423
diff changeset
  1240
!
claus
parents: 423
diff changeset
  1241
claus
parents: 423
diff changeset
  1242
makeUncompiled
claus
parents: 423
diff changeset
  1243
    "make the receiver an uncompiled method, which raises an invalidCodeObject
claus
parents: 423
diff changeset
  1244
     signal when executed. This is not for public use - it is required for
claus
parents: 423
diff changeset
  1245
     the compiler to invalidate methods which cannot be compiled due to errors
claus
parents: 423
diff changeset
  1246
     after a class definition change (for example: instvars are no longer there)."
claus
parents: 423
diff changeset
  1247
claus
parents: 423
diff changeset
  1248
    |invldMethod|
claus
parents: 423
diff changeset
  1249
claus
parents: 423
diff changeset
  1250
    invldMethod := self class compiledMethodAt:#uncompiledCodeObject.
claus
parents: 423
diff changeset
  1251
    self code:invldMethod code.
claus
parents: 423
diff changeset
  1252
    self byteCode:invldMethod byteCode.
claus
parents: 423
diff changeset
  1253
claus
parents: 423
diff changeset
  1254
    "Created: 17.9.1995 / 15:01:14 / claus"
claus
parents: 423
diff changeset
  1255
! !
claus
parents: 423
diff changeset
  1256
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1257
!Method methodsFor:'error handling'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1258
328
claus
parents: 326
diff changeset
  1259
invalidCodeObject
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1260
    "this method is triggered by the interpreter when a nil or non method
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1261
     is about to be executed.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1262
     In this case, the VM sends this to the bad method (the receiver).
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1263
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1264
     Also, the Compiler creates methods with their code/bytecode set to
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1265
     this method if - after a class change - a method cannot be compiled
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1266
     and is therefore no longer executable (for example, after an instvar
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1267
     has been removed, and a method still tries to access this instvar)
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1268
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1269
     Thus, we arrive here, when playing around in a classes methodArray,
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1270
     or compiler/runtime system is broken :-(, 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1271
     or you ignore the error messages during some recompile."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1272
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1273
    ^ InvalidCodeSignal
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1274
	raiseRequestWith:self
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1275
	errorString:'invalid method - not executable'.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1276
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1277
375
claus
parents: 362
diff changeset
  1278
uncompiledCodeObject
claus
parents: 362
diff changeset
  1279
    "this method is invoked by methods which contain primitive code,
claus
parents: 362
diff changeset
  1280
     but have not been compiled to machine code (either due to an error
claus
parents: 362
diff changeset
  1281
     when compiling, or simply because no stc is available.
claus
parents: 362
diff changeset
  1282
     For those methods, the compiler generated a method object consisting
claus
parents: 362
diff changeset
  1283
     of the original source code, but with this methods machine/byte code.
claus
parents: 362
diff changeset
  1284
     Therefore, we patch (kludge) the lineNumber information, to show the
claus
parents: 362
diff changeset
  1285
     first line (instead of the real line below)"
claus
parents: 362
diff changeset
  1286
claus
parents: 362
diff changeset
  1287
    thisContext setLineNumber:1.
claus
parents: 362
diff changeset
  1288
    ^ InvalidCodeSignal
claus
parents: 362
diff changeset
  1289
	raiseRequestWith:self
claus
parents: 362
diff changeset
  1290
	errorString:'invalid method - not compiled'.
claus
parents: 362
diff changeset
  1291
!
claus
parents: 362
diff changeset
  1292
 
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1293
wrongNumberOfArguments:numberGiven
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1294
    "this error is triggered, if a method is called with a wrong number
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1295
     of arguments. This only applies to #valueWithReceiverXXX - sends.
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1296
     With a normal send, this error cannot happen."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1297
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1298
    ^ ArgumentSignal
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1299
	raiseRequestWith:self
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1300
	errorString:('method got ' , numberGiven printString ,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1301
		     ' args while ' , self numberOfMethodArgs printString , ' where expected')
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1302
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1303
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1304
privateMethodCalled
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1305
    "this error is triggered, if a private or protected method is called from
360
claus
parents: 350
diff changeset
  1306
     outside. 
claus
parents: 350
diff changeset
  1307
     If you continue in the debugger, the method will be called,
415
claus
parents: 414
diff changeset
  1308
     and further privacy exceptions will NOT be reported at this call location, 
360
claus
parents: 350
diff changeset
  1309
     until any new method is compiled, or the privacy of any method changes,
claus
parents: 350
diff changeset
  1310
     or the caches are flushed.
claus
parents: 350
diff changeset
  1311
     (the reason is that after the continue, the method is enterred into the
claus
parents: 350
diff changeset
  1312
      calling cache, for which method privacy is not checked.
claus
parents: 350
diff changeset
  1313
      Any of the above actions flushes this cache and a privacy check
claus
parents: 350
diff changeset
  1314
      is performed again.)
claus
parents: 350
diff changeset
  1315
     Future versions may not enter private methods into the cache, to fix this
claus
parents: 350
diff changeset
  1316
     (unobvious) behavior. However, then you will get an exception for EVERY
claus
parents: 350
diff changeset
  1317
     call to a private method ...
claus
parents: 350
diff changeset
  1318
claus
parents: 350
diff changeset
  1319
     Notice: method privacy is a nonstandard feature, not supported
claus
parents: 350
diff changeset
  1320
     by other smalltalk implementations and not specified in the ANSI spec.
claus
parents: 350
diff changeset
  1321
     This is EXPERIMENTAL - and being evaluated for usability.
claus
parents: 350
diff changeset
  1322
     It may change or even vanish (if it shows to be not useful)."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1323
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1324
    ^ PrivateMethodSignal raise
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1325
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1326
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1327
!Method methodsFor:'executing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1328
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1329
valueWithReceiver:anObject arguments:argArray
2
claus
parents: 1
diff changeset
  1330
    "low level call of a methods code - BIG DANGER ALERT.
claus
parents: 1
diff changeset
  1331
     Perform the receiver-method on anObject as receiver and argArray as
claus
parents: 1
diff changeset
  1332
     arguments. This does NO message lookup at all and mimics a
claus
parents: 1
diff changeset
  1333
     traditional function call.
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1334
     This method is provided for debugging- and breakpoint-support 
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1335
     (replacing a method by a stub and recalling the original), or to implement
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1336
     experimental MI implementations - it is not for general use. 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1337
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1338
     The receiver must be a method compiled in anObjects class or one of its 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1339
     superclasses and also, the number of arguments given must match the methods
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1340
     expectations -
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1341
     - otherwise strange things (and also strange crashes) can occur.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1342
     The system is NOT always detecting a wrong method/receiver combination.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1343
     YOU HAVE BEEN WARNED."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1344
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1345
    ^ self valueWithReceiver:anObject arguments:argArray selector:nil search:nil
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1346
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1347
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1348
valueWithReceiver:anObject arguments:argArray selector:aSymbol
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1349
    "low level call of a methods code - BIG DANGER ALERT.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1350
     Perform the receiver-method on anObject as receiver and argArray as
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1351
     arguments. This does NO message lookup at all and mimics a
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1352
     traditional function call.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1353
     This method is provided for debugging- and breakpoint-support 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1354
     (replacing a method by a stub and recalling the original), or to implement
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1355
     experimental MI implementations - it is not for general use. 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1356
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1357
     The receiver must be a method compiled in anObjects class or one of its 
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1358
     superclasses and also, the number of arguments given must match the methods
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1359
     expectations -
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1360
     - otherwise strange things (and also strange crashes) can occur.
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
  1361
     The system is NOT always detecting a wrong method/receiver combination.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1362
     YOU HAVE BEEN WARNED."
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1363
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1364
    ^ self valueWithReceiver:anObject 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1365
		   arguments:argArray 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1366
		    selector:aSymbol 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1367
		      search:nil
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1368
		      sender:nil
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1369
!
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1370
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1371
valueWithReceiver:anObject arguments:argArray selector:aSymbol search:aClass
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1372
    "low level call of a methods code - BIG DANGER ALERT.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1373
     Perform the receiver-method on anObject as receiver and argArray as
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1374
     arguments. This does NO message lookup at all and mimics a
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1375
     traditional function call.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1376
     This method is provided for debugging- and breakpoint-support 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1377
     (replacing a method by a stub and recalling the original), or to implement
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1378
     experimental MI implementations - it is not for general use. 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1379
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1380
     The receiver must be a method compiled in anObjects class or one of its 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1381
     superclasses and also, the number of arguments given must match the methods
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1382
     expectations -
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1383
     - otherwise strange things (and also strange crashes) can occur.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1384
     The system is NOT always detecting a wrong method/receiver combination.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1385
     YOU HAVE BEEN WARNED."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1386
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1387
    ^ self valueWithReceiver:anObject 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1388
		   arguments:argArray 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1389
		    selector:aSymbol 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1390
		      search:nil
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1391
		      sender:nil
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1392
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1393
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1394
valueWithReceiver:anObject arguments:argArray selector:aSymbol search:aClass sender:virtualSender
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1395
    "low level call of a methods code - BIG DANGER ALERT.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1396
     Perform the receiver-method on anObject as receiver and argArray as
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1397
     arguments. This does NO message lookup at all and mimics a
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1398
     traditional function call.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1399
     This method is provided for debugging- and breakpoint-support 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1400
     (replacing a method by a stub and recalling the original), or to implement
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1401
     experimental MI implementations - it is not for general use. 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1402
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1403
     The receiver must be a method compiled in anObjects class or one of its 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1404
     superclasses and also, the number of arguments given must match the methods
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1405
     expectations -
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1406
     - otherwise strange things (and also strange crashes) can occur.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1407
     The system is NOT always detecting a wrong method/receiver combination.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1408
     YOU HAVE BEEN WARNED."
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1409
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1410
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1411
    OBJFUNC code;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1412
    OBJ searchClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1413
    static struct inlineCache dummy = _DUMMYILC0;
2
claus
parents: 1
diff changeset
  1414
    int nargs;
claus
parents: 1
diff changeset
  1415
    OBJ *ap;
claus
parents: 1
diff changeset
  1416
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1417
    if (__isArray(argArray)) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1418
	nargs = _arraySize(argArray);
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1419
	ap = _ArrayInstPtr(argArray)->a_element;
2
claus
parents: 1
diff changeset
  1420
    } else {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1421
	if (argArray == nil) {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1422
	    nargs = 0;
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1423
	} else
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1424
	    nargs = -1;
2
claus
parents: 1
diff changeset
  1425
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1426
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1427
#ifdef F_NARGS
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1428
    if (((_intVal(_INST(flags)) & F_NARGS) >> F_NARGSHIFT) == nargs) 
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1429
#endif
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1430
    {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1431
	code = _MethodInstPtr(self)->m_code;
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1432
	if (aClass == nil) {
328
claus
parents: 326
diff changeset
  1433
	    searchClass = dummy.ilc_class = __Class(anObject);
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1434
	} else {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1435
	    searchClass = dummy.ilc_class = aClass;
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1436
	}
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1437
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1438
	if (nargs <= 15) {
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1439
	  /*
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1440
	   * add virtual sender (unwinding) here later,
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1441
	   * to allow hiding contexts in lazy methods.
328
claus
parents: 326
diff changeset
  1442
	   * (this is cosmetics only; therefore its done later)
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1443
	   */
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1444
	  if (code) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1445
	    /* compiled code */
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1446
	    switch (nargs) {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1447
		case 0:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1448
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1449
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1450
		case 1:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1451
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, ap[0]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1452
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1453
		case 2:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1454
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, ap[0], ap[1]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1455
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1456
		case 3:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1457
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, ap[0], ap[1], ap[2]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1458
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1459
		case 4:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1460
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1461
				 ap[0], ap[1], ap[2], ap[3]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1462
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1463
		case 5:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1464
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1465
				 ap[0], ap[1], ap[2], ap[3], ap[4]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1466
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1467
		case 6:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1468
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1469
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1470
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1471
		case 7:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1472
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1473
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1474
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1475
		case 8:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1476
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1477
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1478
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1479
		case 9:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1480
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1481
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1482
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1483
		case 10:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1484
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1485
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1486
				 ap[9]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1487
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1488
		case 11:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1489
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1490
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1491
				 ap[9], ap[10]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1492
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1493
		case 12:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1494
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1495
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1496
				 ap[9], ap[10], ap[11]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1497
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1498
		case 13:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1499
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1500
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1501
				 ap[9], ap[10], ap[11], ap[12]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1502
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1503
		case 14:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1504
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1505
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1506
				 ap[9], ap[10], ap[11], ap[12], ap[13]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1507
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1508
		case 15:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1509
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1510
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1511
				 ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) );
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1512
	    }
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1513
	  } else {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1514
	    /* interpreted code */
328
claus
parents: 326
diff changeset
  1515
#ifdef PASS_ARG_POINTER
claus
parents: 326
diff changeset
  1516
	    RETURN ( __interpret(self, nargs, anObject, aSymbol, SND_COMMA searchClass, ap) );
claus
parents: 326
diff changeset
  1517
#else
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1518
	    switch (nargs) {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1519
		case 0:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1520
		    RETURN ( interpret(self, 0, anObject, aSymbol, SND_COMMA searchClass) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1521
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1522
		case 1:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1523
		    RETURN ( interpret(self, 1, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1524
				   ap[0]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1525
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1526
		case 2:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1527
		    RETURN ( interpret(self, 2, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1528
				   ap[0], ap[1]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1529
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1530
		case 3:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1531
		    RETURN ( interpret(self, 3, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1532
				   ap[0], ap[1], ap[2]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1533
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1534
		case 4:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1535
		    RETURN ( interpret(self, 4, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1536
				   ap[0], ap[1], ap[2], ap[3]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1537
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1538
		case 5:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1539
		    RETURN ( interpret(self, 5, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1540
				   ap[0], ap[1], ap[2], ap[3], ap[4]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1541
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1542
		case 6:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1543
		    RETURN ( interpret(self, 6, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1544
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1545
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1546
		case 7:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1547
		    RETURN ( interpret(self, 7, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1548
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1549
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1550
		case 8:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1551
		    RETURN ( interpret(self, 8, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1552
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1553
				   ap[7]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1554
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1555
		case 9:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1556
		    RETURN ( interpret(self, 9, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1557
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1558
				   ap[7], ap[8]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1559
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1560
		case 10:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1561
		    RETURN ( interpret(self, 10, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1562
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1563
				   ap[7], ap[8], ap[9]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1564
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1565
		case 11:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1566
		    RETURN ( interpret(self, 11, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1567
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1568
				   ap[7], ap[8], ap[9], ap[10]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1569
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1570
		case 12:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1571
		    RETURN ( interpret(self, 12, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1572
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1573
				   ap[7], ap[8], ap[9], ap[11]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1574
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1575
		case 13:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1576
		    RETURN ( interpret(self, 13, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1577
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1578
				   ap[7], ap[8], ap[9], ap[11], ap[12]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1579
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1580
		case 14:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1581
		    RETURN ( interpret(self, 14, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1582
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1583
				   ap[7], ap[8], ap[9], ap[11], ap[12], ap[13]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1584
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1585
		case 15:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1586
		    RETURN ( interpret(self, 15, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1587
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1588
				   ap[7], ap[8], ap[9], ap[11], ap[12], ap[13], ap[14]) );
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1589
	    }
328
claus
parents: 326
diff changeset
  1590
#endif
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1591
	  }
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1592
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1593
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1594
%}
2
claus
parents: 1
diff changeset
  1595
.
claus
parents: 1
diff changeset
  1596
    (argArray isMemberOf:Array) ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1597
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1598
	 arguments must be either nil or an array
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1599
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1600
	^ self badArgumentArray
2
claus
parents: 1
diff changeset
  1601
    ].
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1602
    (argArray size ~~ self numberOfMethodArgs) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1603
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1604
	 the method expects a different number of arguments
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1605
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1606
	^ self wrongNumberOfArguments:argArray size
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1607
    ].
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1608
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1609
     the VM only supports a limited number of arguments in sends
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1610
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1611
    ^ self tooManyArguments
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1612
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1613
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1614
     (Float compiledMethodAt:#+) 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1615
	valueWithReceiver:1.0 arguments:#(2.0)
2
claus
parents: 1
diff changeset
  1616
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1617
     'the next example is a wrong one - which is detected by True's method ...'.
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1618
     (True compiledMethodAt:#printString) 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1619
	valueWithReceiver:false arguments:nil
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1620
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1621
     'the next example is a wrong one - it is nowhere detected
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1622
      and a wrong value returned ...'.
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1623
     (Point compiledMethodAt:#x) 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1624
	valueWithReceiver:(1->2) arguments:nil
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1625
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1626
     'the next example is VERY bad one - it is nowhere detected
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1627
      and may crash the system WARNING: save your work before doing this ...'.
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1628
     (Point compiledMethodAt:#x) 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1629
	valueWithReceiver:(Object new) arguments:nil
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1630
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1631
     'the next example is a wrong one - which is detected here ...'.
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1632
     (Object compiledMethodAt:#printOn:)
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1633
	valueWithReceiver:false arguments:nil
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1634
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1635
     'the next example is a wrong one - which is detected here ...'.
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1636
     (Object compiledMethodAt:#printOn:)
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1637
	valueWithReceiver:false arguments:#() 
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1638
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1639
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1640
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1641
!Method methodsFor:'printing & storing'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1642
275
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1643
whoString
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1644
    "return a string as className>>selector, if this is not an unbound
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1645
     method. Otherwise return 'unbound'. Used with debugging."
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1646
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1647
    |w|
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1648
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1649
    w := self who.
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1650
    w notNil ifTrue:[
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1651
	^ (w at:1) name , '>>' , (w at:2)
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1652
    ].
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1653
    ^ 'unbound'
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1654
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1655
    "
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1656
     Method new whoString
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1657
     (Method compiledMethodAt:#whoString) whoString
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1658
    "
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1659
!
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1660
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1661
printOn:aStream
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1662
    "put a printed representation of the receiver onto aStream.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1663
     Since methods do not store their class/selector, we have to search
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1664
     for it here."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1665
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1666
    |classAndSelector m wrapped|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1667
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1668
    wrapped := false.
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1669
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1670
    aStream nextPutAll:(self classNameWithArticle).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1671
    aStream nextPut:$(.
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1672
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1673
    classAndSelector := self who.
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1674
    classAndSelector isNil ifTrue:[
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1675
	"
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1676
	 not anchored in any class.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1677
	 check if wrapped (to be more informative in inspectors)
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1678
	"
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1679
	m := self wrapper.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1680
	m notNil ifTrue:[
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1681
	    classAndSelector := m who.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1682
	    wrapped := true.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1683
	]
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1684
    ].
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1685
    classAndSelector notNil ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
  1686
	(classAndSelector at:1) name printOn:aStream.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1687
	aStream nextPutAll:' '.
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1688
	(classAndSelector at:2) printOn:aStream.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1689
	wrapped ifTrue:[
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1690
	    aStream nextPutAll:'; wrapped'
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1691
	].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1692
    ] ifFalse:[
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
  1693
	"
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1694
	 sorry, a method which is nowhere anchored
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
  1695
	"
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1696
	aStream nextPutAll:'unbound'
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1697
    ].
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1698
    aStream nextPut:$)
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1699
48061f8659aa more queries
claus
parents: 159
diff changeset
  1700
    "
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1701
     (Object compiledMethodAt:#at:) printOn:Transcript. Transcript cr.
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1702
     (Object compiledMethodAt:#at:) copy printOn:Transcript. Transcript cr.
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1703
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1704
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1705
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1706
!Method class methodsFor:'binary storage'!
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1707
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1708
binaryDefinitionFrom: stream manager: manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1709
    "read my definition from stream."
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1710
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1711
    |cls sel|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1712
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1713
    "type-byte"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1714
    stream nextByte == 0 ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1715
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1716
	 built-in method
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1717
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1718
	cls := manager nextObject.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1719
	sel := manager nextObject.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1720
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1721
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1722
	 mhmh - on the source system, this was a machinecode
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1723
	 method, while here its an interpreted one ...
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1724
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1725
	cls isLoaded ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1726
	    cls autoload
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1727
	].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1728
	^ cls compiledMethodAt:sel
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1729
    ].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1730
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1731
     bytecode method
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1732
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1733
    ^ super binaryDefinitionFrom:stream manager:manager
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1734
!
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1735
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1736
binaryFullDefinitionFrom:stream manager:manager
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1737
    "retrieve a full bytecoded-method."
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1738
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1739
    |cat flags code lits m sourceFilename sourcePos source|
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1740
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1741
    cat := manager nextObject.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1742
    flags := manager nextObject.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1743
    lits := manager nextObject.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1744
    sourceFilename := manager nextObject.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1745
    sourcePos := manager nextObject.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1746
    sourcePos isNil ifTrue:[
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1747
	source := manager nextObject.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1748
    ].
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1749
    code := manager nextObject.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1750
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1751
    m := Method basicNew.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1752
    m category:cat.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1753
    m flags:flags.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1754
    m literals:lits.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1755
    m byteCode:code.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1756
    sourcePos isNil ifTrue:[
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1757
	m source:source
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1758
    ] ifFalse:[
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1759
	m sourceFilename:sourceFilename position:sourcePos
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1760
    ].
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1761
    ^ m
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1762
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1763
    "Created: 16.1.1996 / 14:44:08 / cg"
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1764
! !
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1765
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1766
!Method methodsFor:'binary storage'!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1767
444
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1768
asExecutableMethod
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1769
    "if the receiver has neither bytecodes nor machinecode, create & return a 
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1770
     method having semantics as the receivers source. This may be machine code,
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1771
     if the system supports dynamic loading of object code and the source includes
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1772
     primitive code. However, bytecode is preferred, since it compiles faster.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1773
     Otherwise, return the receiver. The new method is not installed in
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1774
     the methodDictionary of any class - just returned.
444
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1775
     Can be used to compile lazy methods down to executable ones."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1776
444
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1777
    |temporaryMethod cls sourceString silent lazy|
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1778
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1779
    byteCode notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1780
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1781
	 is already a bytecoded method
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1782
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1783
	^ self
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1784
    ].
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1785
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1786
    cls := self containingClass.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1787
    cls isNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1788
	'cannot generate bytecode (no class for compilation)' errorPrintNL.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1789
	^ nil
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1790
    ].
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1791
    sourceString := self source.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1792
    sourceString isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1793
	'cannot generate bytecode (no source for compilation)' errorPrintNL.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1794
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1795
    ].
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1796
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1797
    "
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1798
     dont want this to go into the changes file,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1799
     dont want output on Transcript and definitely 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1800
     dont want a lazy method ...
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1801
    "
421
claus
parents: 415
diff changeset
  1802
    Class withoutUpdatingChangesDo:[
423
claus
parents: 421
diff changeset
  1803
	silent := Smalltalk silentLoading:true.
claus
parents: 421
diff changeset
  1804
	lazy := Compiler compileLazy:false.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1805
423
claus
parents: 421
diff changeset
  1806
	[
421
claus
parents: 415
diff changeset
  1807
	    |compiler|
350
claus
parents: 345
diff changeset
  1808
421
claus
parents: 415
diff changeset
  1809
	    compiler := cls compilerClass.
350
claus
parents: 345
diff changeset
  1810
421
claus
parents: 415
diff changeset
  1811
	    "/
claus
parents: 415
diff changeset
  1812
	    "/ kludge - have to make ST/X's compiler protocol
claus
parents: 415
diff changeset
  1813
	    "/ be compatible to ST-80's
claus
parents: 415
diff changeset
  1814
	    "/
claus
parents: 415
diff changeset
  1815
	    (compiler respondsTo:#compile:forClass:inCategory:notifying:install:skipIfSame:)
claus
parents: 415
diff changeset
  1816
	    ifTrue:[
423
claus
parents: 421
diff changeset
  1817
		temporaryMethod := compiler
421
claus
parents: 415
diff changeset
  1818
				     compile:sourceString
claus
parents: 415
diff changeset
  1819
				     forClass:cls
claus
parents: 415
diff changeset
  1820
				     inCategory:(self category)
claus
parents: 415
diff changeset
  1821
				     notifying:nil
claus
parents: 415
diff changeset
  1822
				     install:false.
claus
parents: 415
diff changeset
  1823
	    ] ifFalse:[
423
claus
parents: 421
diff changeset
  1824
		temporaryMethod := compiler new
421
claus
parents: 415
diff changeset
  1825
				     compile:sourceString 
claus
parents: 415
diff changeset
  1826
				     in:cls 
claus
parents: 415
diff changeset
  1827
				     notifying:nil 
claus
parents: 415
diff changeset
  1828
				     ifFail:nil
claus
parents: 415
diff changeset
  1829
	    ].
423
claus
parents: 421
diff changeset
  1830
	] valueNowOrOnUnwindDo:[
421
claus
parents: 415
diff changeset
  1831
	    Compiler compileLazy:lazy.
claus
parents: 415
diff changeset
  1832
	    Smalltalk silentLoading:silent.
claus
parents: 415
diff changeset
  1833
	]
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1834
    ].
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1835
    (temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1836
	'cannot generate bytecode (contains primitive code or error)' errorPrintNL.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1837
	^ nil.
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1838
    ].
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1839
    "
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1840
     try to save a bit of memory, by sharing the source (whatever it is)
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1841
    "
192
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
  1842
    temporaryMethod sourceFilename:source position:sourcePosition. 
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1843
    ^ temporaryMethod
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1844
444
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1845
    "Created: 24.10.1995 / 14:02:30 / cg"
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1846
!
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1847
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1848
asByteCodeMethod
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1849
    "if the receiver has no bytecodes, create & return a method having
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1850
     the same semantics as the receiver, but uses interpreted bytecodes.
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1851
     Otherwise, return the receiver. The new method is not installed in
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1852
     the methodDictionary of any class - just returned.
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1853
     Can be used to obtain a bytecode version of a machine-code method, 
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1854
     for binary storage or dynamic recompilation (which is not yet finished)
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1855
     or to compile lazy methods down to executable ones."
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1856
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1857
    |doMachineCode mthd|
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1858
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1859
    byteCode notNil ifTrue:[
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1860
	"
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1861
	 is already a bytecoded method
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1862
	"
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1863
	^ self
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1864
    ].
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1865
    doMachineCode := Compiler stcCompilation:#never.
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1866
    [
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1867
	mthd := self asExecutableMethod.
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1868
    ] valueNowOrOnUnwindDo:[
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1869
	Compiler stcCompilation:doMachineCode.
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1870
    ].
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1871
    ^ mthd
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1872
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1873
    "Created: 24.10.1995 / 14:02:32 / cg"
071b4f32272c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  1874
    "Modified: 24.10.1995 / 14:17:21 / cg"
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1875
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1876
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1877
storeBinaryDefinitionOn:stream manager:manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1878
    "only store bytecode-methods - machinecode methods are stored
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1879
     as class/selector pair and a lookup is done when restored.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1880
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1881
     If the receiver method is a built-in (i.e. machine coded)
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1882
     method, a temporary interpreted byte code method is created,
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1883
     and its bytecode stored. 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1884
     This works only, if the source of the method is available and the
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1885
     method does not contain primitive code."
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1886
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1887
    |storedMethod who|
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1888
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1889
    byteCode isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1890
	self code notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1891
	    (who := self who) notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1892
		"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1893
		 machine code only - assume its a built-in method,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1894
		 and store the class/selector information.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1895
		 The restored method may not be exactly the same ...
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1896
		"
343
claus
parents: 328
diff changeset
  1897
		manager putIdOfClass:(self class) on:stream.
claus
parents: 328
diff changeset
  1898
		stream nextPutByte:0.   "means: built-in method" 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1899
		manager putIdOf:(who at:1) on:stream.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1900
		manager putIdOf:(who at:2) on:stream.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1901
		^ self
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1902
	    ]
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1903
	].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1904
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1905
	storedMethod := self asByteCodeMethod.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1906
	storedMethod isNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1907
	    self error:'store of built-in method failed'.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1908
	    ^ nil
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1909
	].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1910
	^ storedMethod storeBinaryDefinitionOn:stream manager:manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1911
    ].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1912
343
claus
parents: 328
diff changeset
  1913
    manager putIdOfClass:(self class) on:stream.
claus
parents: 328
diff changeset
  1914
    stream nextPutByte:1.       "means: byte-coded method"
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1915
    self storeBinaryDefinitionBodyOn:stream manager:manager
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1916
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1917
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1918
readBinaryContentsFrom: stream manager: manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1919
    "tell the newly restored Font about restoration"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1920
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1921
    self code notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1922
	"built-in method - already complete"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1923
	^ self
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1924
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1925
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1926
    ^ super readBinaryContentsFrom: stream manager: manager
872
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1927
!
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1928
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1929
storeFullBinaryDefinitionOn:stream manager:manager
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1930
    "store full bytecoded-method."
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1931
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1932
    |m code|
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1933
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1934
    category storeBinaryOn:stream manager:manager.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1935
    byteCode isNil ifTrue:[
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1936
	m := self asByteCodeMethod.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1937
	code := m byteCode
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1938
    ] ifFalse:[
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1939
	m := self.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1940
	code := byteCode
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1941
    ].
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1942
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1943
    m flags storeBinaryOn:stream manager:manager.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1944
    m literals storeBinaryOn:stream manager:manager.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1945
    m sourceFilename storeBinaryOn:stream manager:manager.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1946
    m sourcePosition storeBinaryOn:stream manager:manager.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1947
    m sourcePosition isNil ifTrue:[
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1948
	m source storeBinaryOn:stream manager:manager.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1949
    ].
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1950
    code storeBinaryOn:stream manager:manager.
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1951
af04035b443d binary class storage support
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1952
    "Created: 16.1.1996 / 14:41:45 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1953
! !