Method.st
author claus
Thu, 09 Mar 1995 11:44:00 +0100
changeset 306 365e65400c93
parent 302 1f76060d58a4
child 307 cc8fa75c8685
permissions -rw-r--r--
*** empty log message ***
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
a27a279701f8 Initial revision
claus
parents:
diff changeset
    22
Method comment:'
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
    23
COPYRIGHT (c) 1989 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    24
	     All Rights Reserved
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    25
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
    26
$Header: /cvs/stx/stx/libbasic/Method.st,v 1.30 1995-03-09 10:44:00 claus Exp $
42
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    27
'!
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    28
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    29
!Method class methodsFor:'documentation'!
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    30
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    32
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
 COPYRIGHT (c) 1989 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    34
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    45
version
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
"
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
    47
$Header: /cvs/stx/stx/libbasic/Method.st,v 1.30 1995-03-09 10:44:00 claus Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    49
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    50
42
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    51
documentation
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    52
"
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    53
    this class defines protocol for executable methods;
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    54
    both compiled and interpreted methods are represented by this class.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    55
    Compiled methods have a non-nil code field, while interpreted methods have
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    56
    a nil code field and non-nil byteCode field.
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    57
    If there are both non-nil code and bytecode fields, the VM will execute
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    58
    the machine-code of a method. If both are nil when executed, a noByteCode
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    59
    message is sent by the VM to the method where a signal is raised.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    60
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    61
    The methods sourcecode is represented by source and sourcePosition:
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    62
    - if sourcePosition is a Number, the source-field is the fileName and
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    63
      sourcePosition is the character offset of the source-chunk in this source file.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    64
    - If sourcePosition is nil, the source is the string in the source field.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    65
    (an old version used ExternalString instances here, but that lead to
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    66
     10000 additional little objects ...)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    68
    The flags field defines things like the number of method-locals,
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    69
    method arguments and stack requirements (for interpreted methods).
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    70
    Do not depend on any value in the flags field - it may change without
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    71
    notice.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    73
    Instance variables:
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    74
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    75
	source          <String>        the source itself (if sourcePosition isNil)
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    76
					or the fileName where the source is found
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    77
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    78
	sourcePosition  <Integer>       the position of the methods chunk in the file
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    79
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    80
	category        <Symbol>        the methods category
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
    81
	package         <Symbol>        the package, in which the methods was defined
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    82
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    83
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    84
    Class variables:
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    85
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    86
	PrivateMethodSignal             raised on privacy violation (see docu)
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    87
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    88
	LastFileReference               weak reference to the last sourceFile
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
    89
	LastSourceFileName              to speedup source access via NFS
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    90
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    91
    WARNING: layout known by compiler and runtime system - dont change
42
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
    92
"
176
48061f8659aa more queries
claus
parents: 159
diff changeset
    93
!
48061f8659aa more queries
claus
parents: 159
diff changeset
    94
48061f8659aa more queries
claus
parents: 159
diff changeset
    95
privacy 
48061f8659aa more queries
claus
parents: 159
diff changeset
    96
"
48061f8659aa more queries
claus
parents: 159
diff changeset
    97
    ST/X includes an EXPERIMENTAL implementation of method privacy.
48061f8659aa more queries
claus
parents: 159
diff changeset
    98
    Individual methods may be set to private or protected via the
48061f8659aa more queries
claus
parents: 159
diff changeset
    99
    #setPrivate and #setProtected messages. Also, categories may be
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
   100
    filedIn as a whole as private using #privateMethodsFor: or as
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
   101
    protected using #protectedMethodsFor: instead of the well known #methodsFor:.
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
   102
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   103
    The additional #publicMethodsFor: is for documentation purposes, and
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   104
    is equivalent to #methodsFor: (also to support fileIn of ENVY methods).
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   105
48061f8659aa more queries
claus
parents: 159
diff changeset
   106
    Private methods may be executed only when called via a self or super-send
48061f8659aa more queries
claus
parents: 159
diff changeset
   107
    from the superclass, the class itself or subclasses.
48061f8659aa more queries
claus
parents: 159
diff changeset
   108
    Protected methods may not be called from subclasses.
48061f8659aa more queries
claus
parents: 159
diff changeset
   109
48061f8659aa more queries
claus
parents: 159
diff changeset
   110
    When such a situation arises, the VM (runtime system) will raise the
48061f8659aa more queries
claus
parents: 159
diff changeset
   111
    PrivateMethodSignal exception (if nonNil), which usually brings you into the
48061f8659aa more queries
claus
parents: 159
diff changeset
   112
    debugger.
48061f8659aa more queries
claus
parents: 159
diff changeset
   113
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   114
    If PrivateMethodSignal is nil, the VM will not check for this, and
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   115
    execution is as usual. (you may want to nil-it for production code,
48061f8659aa more queries
claus
parents: 159
diff changeset
   116
    and leave it non nil during development).
48061f8659aa more queries
claus
parents: 159
diff changeset
   117
48061f8659aa more queries
claus
parents: 159
diff changeset
   118
    NOTICE: there is no (not yet ?) standard defined for method privacy,
48061f8659aa more queries
claus
parents: 159
diff changeset
   119
    however, the interface was designed to be somewhat ENVY compatible (from
48061f8659aa more queries
claus
parents: 159
diff changeset
   120
    what can be deduced by reading PD code).
48061f8659aa more queries
claus
parents: 159
diff changeset
   121
    Also, the usability of privacy is still to be tested.
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   122
    This interface, the implementation and the rules for when a privacy viaolation
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   123
    is reported may change (in case of some ANSI standard being defined).
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   124
    Be warned and send me suggestions & critics (constructive ;-)
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   125
"
42
e33491f6f260 *** empty log message ***
claus
parents: 39
diff changeset
   126
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   127
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   128
!Method class methodsFor:'initialization'!
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   129
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   130
initialize
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   131
    PrivateMethodSignal isNil ifTrue:[
302
1f76060d58a4 *** empty log message ***
claus
parents: 275
diff changeset
   132
	ExecutionErrorSignal isNil ifTrue:[super initialize].
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   133
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   134
	"EXPERIMENTAL"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   135
	PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   136
	PrivateMethodSignal nameClass:self message:#privateMethodSignal.
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   137
	PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   138
    ]
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   139
! !
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   140
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   141
!Method class methodsFor:'signal access'!
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   142
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   143
privateMethodSignal
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   144
    "return the signal raised when a private/protected method is called
48061f8659aa more queries
claus
parents: 159
diff changeset
   145
     by some other object (i.e. not a self- or super send)"
48061f8659aa more queries
claus
parents: 159
diff changeset
   146
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   147
    ^ PrivateMethodSignal
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   148
! !
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   149
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   150
!Method class methodsFor:'queries'!
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   151
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   152
isBuiltInClass
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   153
    "this class is known by the run-time-system"
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   154
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   155
    ^ self == Method
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   156
!
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   157
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   158
maxNumberOfArguments
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   159
    "this limit will be removed in one of the next versions ..."
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   160
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   161
    ^ 15  "cannot be easily changed"
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   162
! !
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   163
259
   164
!Method methodsFor:'queries'!
   165
   166
isMethod
   167
    "return true, if the receiver is some kind of method;
   168
     true returned here - the method is redefined from Object."
   169
   170
    ^ true
   171
! !
   172
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
!Method methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   174
a27a279701f8 Initial revision
claus
parents:
diff changeset
   175
source
a27a279701f8 Initial revision
claus
parents:
diff changeset
   176
    "return the sourcestring for the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   177
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   178
    |aStream fileName junk|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   179
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
    source notNil ifTrue:[
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   181
	"
48061f8659aa more queries
claus
parents: 159
diff changeset
   182
	 if sourcePosition is nonNil, its the fileName and
48061f8659aa more queries
claus
parents: 159
diff changeset
   183
	 sourcePosition is the offset.
48061f8659aa more queries
claus
parents: 159
diff changeset
   184
	 Otherwise, source is the real source
48061f8659aa more queries
claus
parents: 159
diff changeset
   185
	"
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   186
	sourcePosition isNil ifTrue:[^ source].
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   187
"/
48061f8659aa more queries
claus
parents: 159
diff changeset
   188
"/ original code:
48061f8659aa more queries
claus
parents: 159
diff changeset
   189
"/
48061f8659aa more queries
claus
parents: 159
diff changeset
   190
"/        aStream := Smalltalk systemFileStreamFor:('source/' , source).
48061f8659aa more queries
claus
parents: 159
diff changeset
   191
"/        aStream notNil ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
   192
"/            aStream position:sourcePosition.
48061f8659aa more queries
claus
parents: 159
diff changeset
   193
"/            junk := aStream nextChunk.
48061f8659aa more queries
claus
parents: 159
diff changeset
   194
"/            aStream close
48061f8659aa more queries
claus
parents: 159
diff changeset
   195
"/        ]
48061f8659aa more queries
claus
parents: 159
diff changeset
   196
48061f8659aa more queries
claus
parents: 159
diff changeset
   197
"/
48061f8659aa more queries
claus
parents: 159
diff changeset
   198
"/ we keep the last source file open, because open/close
48061f8659aa more queries
claus
parents: 159
diff changeset
   199
"/ operations maybe somewhat slow on NFS-mounted file systems
48061f8659aa more queries
claus
parents: 159
diff changeset
   200
"/ Since the reference to the file is weak, it will be closed
48061f8659aa more queries
claus
parents: 159
diff changeset
   201
"/ automatically if the file is not referenced for a while. Neat trick.
48061f8659aa more queries
claus
parents: 159
diff changeset
   202
48061f8659aa more queries
claus
parents: 159
diff changeset
   203
	LastSourceFileName = source ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
   204
	    aStream := LastFileReference at:1.
48061f8659aa more queries
claus
parents: 159
diff changeset
   205
	].
48061f8659aa more queries
claus
parents: 159
diff changeset
   206
48061f8659aa more queries
claus
parents: 159
diff changeset
   207
	aStream isNil ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
   208
	    fileName := Smalltalk getSystemFileName:('source/' , source).
192
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
   209
	    fileName isNil ifTrue:[
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
   210
		fileName := source
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
   211
	    ].
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   212
	    aStream := fileName asFilename readStream.
48061f8659aa more queries
claus
parents: 159
diff changeset
   213
	].
48061f8659aa more queries
claus
parents: 159
diff changeset
   214
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   215
	aStream notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   216
	    aStream position:sourcePosition.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   217
	    junk := aStream nextChunk.
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   218
48061f8659aa more queries
claus
parents: 159
diff changeset
   219
	    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   220
	     keep a weak reference - maybe its needed again soon ...
48061f8659aa more queries
claus
parents: 159
diff changeset
   221
	    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   222
	    LastFileReference isNil ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
   223
		LastFileReference := WeakArray new:1
48061f8659aa more queries
claus
parents: 159
diff changeset
   224
	    ].
48061f8659aa more queries
claus
parents: 159
diff changeset
   225
	    LastFileReference at:1 put:aStream.
48061f8659aa more queries
claus
parents: 159
diff changeset
   226
	    LastSourceFileName := source
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   227
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   228
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   229
    ^ junk
a27a279701f8 Initial revision
claus
parents:
diff changeset
   230
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   231
a27a279701f8 Initial revision
claus
parents:
diff changeset
   232
source:aString
a27a279701f8 Initial revision
claus
parents:
diff changeset
   233
    "set the methods sourcestring"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   234
a27a279701f8 Initial revision
claus
parents:
diff changeset
   235
    source := aString.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   236
    sourcePosition := nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
   237
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   238
192
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
   239
sourceFilename
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   240
    "return the sourcefilename if source is extern; nil otherwise"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   241
a27a279701f8 Initial revision
claus
parents:
diff changeset
   242
    sourcePosition notNil ifTrue:[^ source].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   243
    ^ nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
   244
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   245
a27a279701f8 Initial revision
claus
parents:
diff changeset
   246
sourcePosition
a27a279701f8 Initial revision
claus
parents:
diff changeset
   247
    "return the sourceposition if source is extern; nil otherwise"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   248
a27a279701f8 Initial revision
claus
parents:
diff changeset
   249
    ^ sourcePosition
a27a279701f8 Initial revision
claus
parents:
diff changeset
   250
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   251
192
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
   252
sourceFilename:aFileName position:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   253
    "set the methods sourcefile/position"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   254
a27a279701f8 Initial revision
claus
parents:
diff changeset
   255
    source := aFileName.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   256
    sourcePosition := aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   257
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   258
39
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   259
comment
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   260
    "return the methods comment.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   261
     This is done by searching for and returning the first comment
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   262
     from the methods source (excluding any double-quotes). 
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   263
     Returns nil if there is no comment (or source is not available)."
39
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   264
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   265
    |src stream|
39
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   266
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   267
    src := self source.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   268
    src isNil ifTrue:[^ nil].
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   269
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   270
    stream := ReadStream on:src.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   271
    (stream skipThrough:Character doubleQuote) isNil ifTrue:[^ nil].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   272
    ^ stream upTo:Character doubleQuote.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   273
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   274
    "
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   275
     (Method compiledMethodAt:#comment) comment 
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   276
    "
39
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   277
!
bcf183a31bbb *** empty log message ***
claus
parents: 13
diff changeset
   278
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   279
category
a27a279701f8 Initial revision
claus
parents:
diff changeset
   280
    "return the methods category or nil"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   281
a27a279701f8 Initial revision
claus
parents:
diff changeset
   282
    ^ category
a27a279701f8 Initial revision
claus
parents:
diff changeset
   283
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   284
a27a279701f8 Initial revision
claus
parents:
diff changeset
   285
category:aStringOrSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   286
    "set the methods category"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   287
a27a279701f8 Initial revision
claus
parents:
diff changeset
   288
    category := aStringOrSymbol asSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   289
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   290
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   291
package
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   292
    "return the package-symbol"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   293
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   294
    ^ package
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   295
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   296
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   297
package:aSymbol
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   298
    "set the package-symbol"
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   299
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   300
    package := aSymbol
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   301
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   302
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   303
flags
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   304
    "return the flags (number of method variables, stacksize etc.).
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   305
     Dont depend on the values in the flag field - it may change
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   306
     without notice."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   307
a27a279701f8 Initial revision
claus
parents:
diff changeset
   308
    ^ flags
a27a279701f8 Initial revision
claus
parents:
diff changeset
   309
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   310
a27a279701f8 Initial revision
claus
parents:
diff changeset
   311
flags:newFlags
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   312
    "set the flags (number of method variables, stacksize).
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   313
     WARNING: for internal use by the compiler only."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   314
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   315
    "protect myself a bit - putting in an object would crash me ..."
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   316
    (newFlags isMemberOf:SmallInteger) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   317
	flags := newFlags
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   318
    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   319
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   320
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   321
setToPrivate
48061f8659aa more queries
claus
parents: 159
diff changeset
   322
    "set the flag bit stating that this method is private. 
48061f8659aa more queries
claus
parents: 159
diff changeset
   323
     Execution of the receiver will only be allowed for self/super-sends from 
48061f8659aa more queries
claus
parents: 159
diff changeset
   324
     the class, superclasses or subclasses (or via #perform).
48061f8659aa more queries
claus
parents: 159
diff changeset
   325
     If a private method is called by some other class, a runtime
48061f8659aa more queries
claus
parents: 159
diff changeset
   326
     error (PrivateMethodSignal) is raised.
48061f8659aa more queries
claus
parents: 159
diff changeset
   327
     Notice: method privacy is a nonstandard feature, not supported
48061f8659aa more queries
claus
parents: 159
diff changeset
   328
     by other smalltalk implementations and not specified in the ANSI spec.
48061f8659aa more queries
claus
parents: 159
diff changeset
   329
     This is EXPERIMENTAL - and being evaluated for usability.
48061f8659aa more queries
claus
parents: 159
diff changeset
   330
     It may change or even vanish (if it shows to be not useful)."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   331
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   332
%{  /* NOCONTEXT */
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   333
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   334
48061f8659aa more queries
claus
parents: 159
diff changeset
   335
#ifdef F_PRIVATE
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   336
    int f = _intVal(_INST(flags));
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   337
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   338
    f = f | F_PRIVATE;
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   339
    _INST(flags) = _MKSMALLINT(f);
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   340
#endif
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   341
%}
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   342
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   343
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   344
setToProtected
48061f8659aa more queries
claus
parents: 159
diff changeset
   345
    "set the flag bit stating that this method is protected. 
48061f8659aa more queries
claus
parents: 159
diff changeset
   346
     Execution of the receiver will only be allowed for self sends from
48061f8659aa more queries
claus
parents: 159
diff changeset
   347
     the class or superclasses. (or via #perform).
48061f8659aa more queries
claus
parents: 159
diff changeset
   348
     If a private method is called by some other class, a runtime
48061f8659aa more queries
claus
parents: 159
diff changeset
   349
     error (PrivateMethodSignal) is raised.
48061f8659aa more queries
claus
parents: 159
diff changeset
   350
     Notice: method privacy is a nonstandard feature, not supported
48061f8659aa more queries
claus
parents: 159
diff changeset
   351
     by other smalltalk implementations and not specified in the ANSI spec.
48061f8659aa more queries
claus
parents: 159
diff changeset
   352
     This is EXPERIMENTAL - and being evaluated for usability.
48061f8659aa more queries
claus
parents: 159
diff changeset
   353
     It may change or even vanish (if it shows to be not useful)."
48061f8659aa more queries
claus
parents: 159
diff changeset
   354
48061f8659aa more queries
claus
parents: 159
diff changeset
   355
%{  /* NOCONTEXT */
48061f8659aa more queries
claus
parents: 159
diff changeset
   356
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   357
48061f8659aa more queries
claus
parents: 159
diff changeset
   358
#ifdef F_CLASSPRIVATE
48061f8659aa more queries
claus
parents: 159
diff changeset
   359
    int f = _intVal(_INST(flags));
48061f8659aa more queries
claus
parents: 159
diff changeset
   360
48061f8659aa more queries
claus
parents: 159
diff changeset
   361
    f = f | F_CLASSPRIVATE;
48061f8659aa more queries
claus
parents: 159
diff changeset
   362
    _INST(flags) = _MKSMALLINT(f);
48061f8659aa more queries
claus
parents: 159
diff changeset
   363
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   364
%}
48061f8659aa more queries
claus
parents: 159
diff changeset
   365
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   366
48061f8659aa more queries
claus
parents: 159
diff changeset
   367
setToPublic
213
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
   368
    "clear any privacy of the receiver. The receiver may be executed by
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   369
     any send. This is the default."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   370
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   371
%{  /* NOCONTEXT */
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   372
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   373
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   374
    int f = _intVal(_INST(flags));
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   375
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   376
#if F_PRIVATE
48061f8659aa more queries
claus
parents: 159
diff changeset
   377
    f = f & ~F_PRIVATE;
48061f8659aa more queries
claus
parents: 159
diff changeset
   378
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   379
#if F_CLASSPRIVATE
48061f8659aa more queries
claus
parents: 159
diff changeset
   380
    f = f & ~F_CLASSPRIVATE;
48061f8659aa more queries
claus
parents: 159
diff changeset
   381
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   382
    _INST(flags) = _MKSMALLINT(f);
48061f8659aa more queries
claus
parents: 159
diff changeset
   383
%}
48061f8659aa more queries
claus
parents: 159
diff changeset
   384
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   385
48061f8659aa more queries
claus
parents: 159
diff changeset
   386
isPrivate
48061f8659aa more queries
claus
parents: 159
diff changeset
   387
    "return true, if this is a private method.
48061f8659aa more queries
claus
parents: 159
diff changeset
   388
     Execution of private methods is only allowed via self/super sends
48061f8659aa more queries
claus
parents: 159
diff changeset
   389
     from superclasses, the class itself or subclasses.
48061f8659aa more queries
claus
parents: 159
diff changeset
   390
     If a private method is called by some other class, a runtime
48061f8659aa more queries
claus
parents: 159
diff changeset
   391
     error (PrivateMethodSignal) is raised.
48061f8659aa more queries
claus
parents: 159
diff changeset
   392
     Notice: method privacy is a nonstandard feature, not supported
48061f8659aa more queries
claus
parents: 159
diff changeset
   393
     by other smalltalk implementations and not specified in the ANSI spec.
48061f8659aa more queries
claus
parents: 159
diff changeset
   394
     This is EXPERIMENTAL - and being evaluated for usability.
48061f8659aa more queries
claus
parents: 159
diff changeset
   395
     It may change or even vanish (if it shows to be not useful)."
48061f8659aa more queries
claus
parents: 159
diff changeset
   396
48061f8659aa more queries
claus
parents: 159
diff changeset
   397
%{  /* NOCONTEXT */
48061f8659aa more queries
claus
parents: 159
diff changeset
   398
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   399
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   400
#ifdef F_PRIVATE
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   401
    int f = _intVal(_INST(flags));
48061f8659aa more queries
claus
parents: 159
diff changeset
   402
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   403
    if (f & F_PRIVATE) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   404
	RETURN (true);
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   405
    }
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   406
#endif
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   407
%}.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   408
    ^ false
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   409
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   410
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   411
isProtected
48061f8659aa more queries
claus
parents: 159
diff changeset
   412
    "return true, if this is a protected method.
48061f8659aa more queries
claus
parents: 159
diff changeset
   413
     Execution of protected methods is only allowed via self sends
48061f8659aa more queries
claus
parents: 159
diff changeset
   414
     from superclasses or the class itself.
48061f8659aa more queries
claus
parents: 159
diff changeset
   415
     If a protected method is called by some other class, a runtime
48061f8659aa more queries
claus
parents: 159
diff changeset
   416
     error (PrivateMethodSignal) is raised.
48061f8659aa more queries
claus
parents: 159
diff changeset
   417
     Notice: method privacy is a nonstandard feature, not supported
48061f8659aa more queries
claus
parents: 159
diff changeset
   418
     by other smalltalk implementations and not specified in the ANSI spec.
48061f8659aa more queries
claus
parents: 159
diff changeset
   419
     This is EXPERIMENTAL - and being evaluated for usability.
48061f8659aa more queries
claus
parents: 159
diff changeset
   420
     It may change or even vanish (if it shows to be not useful)."
48061f8659aa more queries
claus
parents: 159
diff changeset
   421
48061f8659aa more queries
claus
parents: 159
diff changeset
   422
%{  /* NOCONTEXT */
48061f8659aa more queries
claus
parents: 159
diff changeset
   423
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   424
48061f8659aa more queries
claus
parents: 159
diff changeset
   425
#ifdef F_CLASSPRIVATE
48061f8659aa more queries
claus
parents: 159
diff changeset
   426
    int f = _intVal(_INST(flags));
48061f8659aa more queries
claus
parents: 159
diff changeset
   427
48061f8659aa more queries
claus
parents: 159
diff changeset
   428
    if (f & F_CLASSPRIVATE) {
48061f8659aa more queries
claus
parents: 159
diff changeset
   429
	RETURN (true);
48061f8659aa more queries
claus
parents: 159
diff changeset
   430
    }
48061f8659aa more queries
claus
parents: 159
diff changeset
   431
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   432
%}.
48061f8659aa more queries
claus
parents: 159
diff changeset
   433
    ^ false
48061f8659aa more queries
claus
parents: 159
diff changeset
   434
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   435
48061f8659aa more queries
claus
parents: 159
diff changeset
   436
isPublic
48061f8659aa more queries
claus
parents: 159
diff changeset
   437
    "return true, if this is a public method - I.e. can be executed via any send.
48061f8659aa more queries
claus
parents: 159
diff changeset
   438
     This is the default."
48061f8659aa more queries
claus
parents: 159
diff changeset
   439
48061f8659aa more queries
claus
parents: 159
diff changeset
   440
%{  /* NOCONTEXT */
48061f8659aa more queries
claus
parents: 159
diff changeset
   441
    /* I made this a primitive to get the define constant from stc.h */
48061f8659aa more queries
claus
parents: 159
diff changeset
   442
48061f8659aa more queries
claus
parents: 159
diff changeset
   443
    int f = _intVal(_INST(flags));
48061f8659aa more queries
claus
parents: 159
diff changeset
   444
#ifdef F_PRIVATE
48061f8659aa more queries
claus
parents: 159
diff changeset
   445
    if (f & F_PRIVATE) {
48061f8659aa more queries
claus
parents: 159
diff changeset
   446
	RETURN (false);
48061f8659aa more queries
claus
parents: 159
diff changeset
   447
    }
48061f8659aa more queries
claus
parents: 159
diff changeset
   448
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   449
#ifdef F_CLASSPRIVATE
48061f8659aa more queries
claus
parents: 159
diff changeset
   450
    if (f & F_CLASSPRIVATE) {
48061f8659aa more queries
claus
parents: 159
diff changeset
   451
	RETURN (false);
48061f8659aa more queries
claus
parents: 159
diff changeset
   452
    }
48061f8659aa more queries
claus
parents: 159
diff changeset
   453
#endif
48061f8659aa more queries
claus
parents: 159
diff changeset
   454
%}.
48061f8659aa more queries
claus
parents: 159
diff changeset
   455
    ^ true
48061f8659aa more queries
claus
parents: 159
diff changeset
   456
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   457
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   458
numberOfMethodArgs:aNumber
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   459
    "currently, the number of arguments is NOT remembered in
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   460
     methods, but this will be added soon to allow for more checking
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   461
     in #perform:.
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   462
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   463
     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
   464
     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
   465
     will be removed in a later release, allowing any number of arguments.
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   466
     - for use by compiler only."
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   467
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   468
    (aNumber between:0 and:self class maxNumberOfArguments) ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   469
	self error:('ST/X only supports up to a maximum of ' ,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   470
		    self class maxNumberOfArguments printString ,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   471
		    ' method arguments').
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   472
	^ self
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   473
    ].
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   474
%{
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   475
    /* made this a primitive to get define in stc.h */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   476
#ifdef F_NARGS
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   477
    _INST(flags) = _MKSMALLINT( (_intVal(_INST(flags)) & ~F_NARGS) | (_intVal(aNumber) << F_NARGSHIFT) );
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   478
#endif
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   479
%}
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   480
!
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   481
     
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   482
numberOfMethodArgs
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   483
    "return the number of arguments, the method expects." 
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   484
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   485
%{  /* NOCONTEXT */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   486
    /* made this a primitive to get define in stc.h */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   487
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   488
#ifdef F_NARGS
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   489
    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NARGS) >> F_NARGSHIFT));
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   490
#endif
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   491
%}
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   492
.
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   493
    "
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   494
     The old implementation simply counted the arguments from
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   495
     the methods source - new versions include this information
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   496
     in the flag instVar, for more security in #perform:
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   497
    "
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   498
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   499
    ^ self methodArgNames size
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   500
!
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   501
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   502
numberOfMethodVars:aNumber
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   503
    "set the number of method variables - for use by compiler only.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   504
     WARNING: playing around here with incorrect values 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   505
	      may crash smalltalk badly."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   506
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   507
%{  /* NOCONTEXT */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   508
    int f = _intVal(_INST(flags));
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   509
a27a279701f8 Initial revision
claus
parents:
diff changeset
   510
    /* made this a primitive to get define in stc.h */
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
   511
    if (__isSmallInteger(aNumber)) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   512
	f = (f & ~F_NVARS) | (_intVal(aNumber) << F_NVARSHIFT);
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   513
	_INST(flags) = _MKSMALLINT(f);
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   514
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   515
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   516
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   517
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   518
numberOfMethodVars
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   519
    "return the number of method local variables. 
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   520
     Do not depend on the returned value - future optimizations
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   521
     may change things here (i.e. when moving block-locals into
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   522
     surrounding method for inlining).
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   523
     - for debugging only."
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   524
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   525
%{  /* NOCONTEXT */
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   526
    /* made this a primitive to get define in stc.h */
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   527
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   528
    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NVARS) >> F_NVARSHIFT));
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   529
%}
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   530
!
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   531
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   532
stackSize:aNumber
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   533
    "set the depth of the local stack - for use by compiler only.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   534
     WARNING: playing around here with incorrect values 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   535
	      may crash smalltalk badly.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   536
	      (if the runtime library was compiled with DEBUG, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   537
	       a bad stack will be detected and triggers an error)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   538
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   539
%{  /* NOCONTEXT */
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   540
    int f = _intVal(_INST(flags));
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   541
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   542
    /* made this a primitive to get define in stc.h */
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
   543
    if (__isSmallInteger(aNumber)) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   544
	f = (f & ~F_NSTACK) | (_intVal(aNumber) << F_NSTACKSHIFT);
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   545
	_INST(flags) = _MKSMALLINT(f);
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   546
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   547
%}
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   548
!
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   549
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   550
stackSize
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   551
    "return the number of temporaries needed as stack in the context. 
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   552
     Do not depend on the returned value - future optimizations
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   553
     may change things here.
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   554
     - for debugging only."
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   555
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   556
%{  /* NOCONTEXT */
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   557
    /* made this a primitive to get define in stc.h */
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   558
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   559
    RETURN (_MKSMALLINT((_intVal(_INST(flags)) & F_NSTACK) >> F_NSTACKSHIFT));
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   560
%}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   561
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   562
a27a279701f8 Initial revision
claus
parents:
diff changeset
   563
!Method methodsFor:'queries'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   564
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   565
who
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   566
    "return the class and selector of where I am defined in. 
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   567
     Since there is no information of the containing class 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   568
     in the method, we have to do a search here.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   569
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   570
     Normally, this is not a problem, except when a method is
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   571
     accepted in the debugger or redefined from within a method
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   572
     (maybe done indirectly, if doIt is done recursively)
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   573
     - the information about which class the original method was 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   574
     defined in is lost in this case.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   575
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   576
     Problem: this is heavily called for in the debugger to create
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   577
	      a readable context walkback. For unbound methods, it is
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   578
	      slow, since the search (over all classes) will always fail.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   579
     Q: should we add a backref from the method to the class 
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   580
	and/or add a subclass of Method for unbound ones ?"
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   581
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   582
    |classes cls sel|
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   583
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   584
    "
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   585
     very first, look in the class we found something the last time
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   586
     this may often give a hit, when asking who repeatingly for
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   587
     a context chain. (keep last by its name, to not keep classes from
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   588
     being garbage collected)
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   589
    "
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   590
    LastWhoClass notNil ifTrue:[
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   591
	cls := Smalltalk at:LastWhoClass.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   592
	sel := cls selectorForMethod:self.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   593
	sel notNil ifTrue:[^ Array with:cls with:sel].
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   594
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   595
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   596
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   597
     first, limit the search to global classes only - 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   598
     since probability is high, that the receiver is found in there ...
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   599
    "
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   600
    classes := Smalltalk allBehaviors.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   601
    "
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   602
     instance methods are usually more common - search those first
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   603
    "
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   604
    classes do:[:aClass |
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   605
	|sel|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   606
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   607
	sel := aClass selectorForMethod:self.
306
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   608
	sel notNil ifTrue:[LastWhoClass := aClass name.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   609
			   ^ Array with:aClass with:sel].
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   610
    ].
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   611
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   612
    LastWhoClass := nil.
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   613
    classes do:[:aClass |
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   614
	|sel|
365e65400c93 *** empty log message ***
claus
parents: 302
diff changeset
   615
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   616
	sel := aClass class selectorForMethod:self.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   617
	sel notNil ifTrue:[^ Array with:aClass class with:sel].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   618
    ].
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   619
    "
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   620
     mhmh - must be a method of some anonymous class (i.e. one not
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   621
     in the Smalltalk dictionary). Search all instances of Behavior
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   622
    "
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   623
    Behavior allDerivedInstancesDo:[:someClass |
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   624
	|sel|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   625
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   626
	sel := someClass selectorForMethod:self.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   627
	sel notNil ifTrue:[^ Array with:someClass with:sel]
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   628
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   629
    "
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   630
     none found - sorry
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   631
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   632
    ^ nil
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   633
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   634
    "typical situation: some well-known class"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   635
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   636
     |m|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   637
     m := Object compiledMethodAt:#copy.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   638
     m who
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   639
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   640
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   641
    "untypical situation: an anonymous class"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   642
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   643
     |m cls|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   644
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   645
     Object 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   646
	subclass:#FunnyClass 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   647
	instanceVariableNames:'foo'
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   648
	classVariableNames:''
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   649
	poolDictionaries:''
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   650
	category:'testing'.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   651
     cls := Smalltalk at:#FunnyClass.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   652
     Smalltalk removeClass:cls.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   653
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   654
     cls compile:'testMethod1:arg foo:=arg'.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   655
     cls compile:'testMethod2 ^ foo'.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   656
     m := cls compiledMethodAt:#testMethod1:.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   657
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   658
     m who
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   659
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   660
!
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   661
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   662
containingClass
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   663
    "return the class I am defined in. 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   664
     See comment in who."
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   665
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   666
    "based on who, which has been added for ST-80 compatibility"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   667
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   668
    |pair|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   669
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   670
    pair := self who.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   671
    pair notNil ifTrue:[^ pair at:1].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   672
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   673
     none found - sorry
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   674
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   675
    ^ nil
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   676
48061f8659aa more queries
claus
parents: 159
diff changeset
   677
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   678
     |m|
48061f8659aa more queries
claus
parents: 159
diff changeset
   679
     m := Object compiledMethodAt:#at:.
48061f8659aa more queries
claus
parents: 159
diff changeset
   680
     m containingClass
48061f8659aa more queries
claus
parents: 159
diff changeset
   681
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   682
!
48061f8659aa more queries
claus
parents: 159
diff changeset
   683
48061f8659aa more queries
claus
parents: 159
diff changeset
   684
selector
48061f8659aa more queries
claus
parents: 159
diff changeset
   685
    "return the selector under which I am found in my containingClasses
48061f8659aa more queries
claus
parents: 159
diff changeset
   686
     method-table. 
48061f8659aa more queries
claus
parents: 159
diff changeset
   687
     See comment in who."
48061f8659aa more queries
claus
parents: 159
diff changeset
   688
48061f8659aa more queries
claus
parents: 159
diff changeset
   689
    "based on who, which has been added for ST-80 compatibility"
48061f8659aa more queries
claus
parents: 159
diff changeset
   690
48061f8659aa more queries
claus
parents: 159
diff changeset
   691
    |pair|
48061f8659aa more queries
claus
parents: 159
diff changeset
   692
48061f8659aa more queries
claus
parents: 159
diff changeset
   693
    pair := self who.
48061f8659aa more queries
claus
parents: 159
diff changeset
   694
    pair notNil ifTrue:[^ pair at:2].
48061f8659aa more queries
claus
parents: 159
diff changeset
   695
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   696
     none found - sorry
48061f8659aa more queries
claus
parents: 159
diff changeset
   697
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   698
    ^ nil
48061f8659aa more queries
claus
parents: 159
diff changeset
   699
48061f8659aa more queries
claus
parents: 159
diff changeset
   700
    "
48061f8659aa more queries
claus
parents: 159
diff changeset
   701
     |m|
48061f8659aa more queries
claus
parents: 159
diff changeset
   702
     m := Object compiledMethodAt:#at:.
48061f8659aa more queries
claus
parents: 159
diff changeset
   703
     m selector
48061f8659aa more queries
claus
parents: 159
diff changeset
   704
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   705
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   706
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   707
parse:parseSelector return:accessSelector or:valueIfNoSource 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   708
    "helper for methodArgNames, methodVarNames etc.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   709
     Get the source, let parser parse it using parseSelector,
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   710
     return parser info using accessSelector"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   711
a27a279701f8 Initial revision
claus
parents:
diff changeset
   712
    |parser sourceString|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   713
a27a279701f8 Initial revision
claus
parents:
diff changeset
   714
    sourceString := self source.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   715
    sourceString notNil ifTrue:[
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   716
	parser := Parser perform:parseSelector with:sourceString.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   717
	(parser isNil or:[parser == #Error]) ifTrue:[^ nil].
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   718
	^ parser perform:accessSelector
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   719
    ].
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   720
    ^ valueIfNoSource 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   721
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   722
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   723
methodArgNames
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   724
    "return a collection with the methods argument names.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   725
     Uses Parser to parse methods source and extract the names."
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   726
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   727
    ^ self parse:#parseMethodSpecification: return:#methodArgs or:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   728
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   729
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   730
     (Method compiledMethodAt:#printOn:) methodArgNames
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   731
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   732
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   733
a27a279701f8 Initial revision
claus
parents:
diff changeset
   734
methodVarNames
a27a279701f8 Initial revision
claus
parents:
diff changeset
   735
    "return a collection with the methods local-variable names.
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   736
     Uses Parser to parse methods source and extract the names."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   737
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   738
    ^ self parse:#parseMethodArgAndVarSpecification: return:#methodVars or:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   739
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   740
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   741
     (Method compiledMethodAt:#printOn:) methodVarNames
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   742
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   743
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   744
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   745
hasPrimitiveCode
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   746
    "return true, if the method contains primitive code; false if not.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   747
     Uses Parser to parse methods source and get the information."
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   748
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   749
    ^ self parse:#parseMethod: return:#hasPrimitiveCode or:false
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   750
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   751
    "
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   752
     (Method compiledMethodAt:#hasPrimitiveCode) hasPrimitiveCode 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   753
     (Object compiledMethodAt:#at:) hasPrimitiveCode   
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   754
     (Object compiledMethodAt:#basicAt:) hasPrimitiveCode 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   755
    "
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   756
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   757
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   758
methodArgAndVarNames
a27a279701f8 Initial revision
claus
parents:
diff changeset
   759
    "return a collection with the methods argument and variable names.
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   760
     Uses Parser to parse methods source and extract the names."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   761
a27a279701f8 Initial revision
claus
parents:
diff changeset
   762
    |parser sourceString argNames varNames|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   763
a27a279701f8 Initial revision
claus
parents:
diff changeset
   764
    sourceString := self source.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   765
    sourceString notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   766
	parser := Parser parseMethodArgAndVarSpecification:sourceString.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   767
	(parser isNil or:[parser == #Error]) ifTrue:[^ nil].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   768
	argNames := parser methodArgs.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   769
	varNames := parser methodVars.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   770
	argNames isNil ifTrue:[^ varNames].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   771
	varNames isNil ifTrue:[^ argNames].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   772
	^ (argNames , varNames)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   773
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   774
    ^ nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
   775
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   776
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   777
     (Method compiledMethodAt:#printOn:) methodArgAndVarNames
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   778
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   779
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   780
a27a279701f8 Initial revision
claus
parents:
diff changeset
   781
methodComment
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   782
    "return the methods first comment, nil if there is none.
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   783
     This is a somewhat stupid implementation."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   784
a27a279701f8 Initial revision
claus
parents:
diff changeset
   785
    |text line nQuote index qIndex qIndex2 comment|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   786
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
   787
    text := self source asCollectionOfLines.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   788
    (text size < 2) ifTrue:[^nil].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   789
a27a279701f8 Initial revision
claus
parents:
diff changeset
   790
    line := (text at:2).
a27a279701f8 Initial revision
claus
parents:
diff changeset
   791
    nQuote := line occurrencesOf:(Character doubleQuote).
a27a279701f8 Initial revision
claus
parents:
diff changeset
   792
    (nQuote == 2) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   793
	qIndex := line indexOf:(Character doubleQuote).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   794
	qIndex2 := line indexOf:(Character doubleQuote) startingAt:(qIndex + 1).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   795
	^ line copyFrom:(qIndex + 1) to:(qIndex2 - 1)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   796
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   797
    (nQuote == 1) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   798
	qIndex := line indexOf:(Character doubleQuote).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   799
	comment := line copyFrom:(qIndex + 1).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   800
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   801
	index := 3.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   802
	line := text at:index.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   803
	nQuote := line occurrencesOf:(Character doubleQuote).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   804
	[nQuote ~~ 1] whileTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   805
	    comment := comment , Character cr asString , line withoutSpaces.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   806
	    index := index + 1.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   807
	    line := text at:index.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   808
	    nQuote := line occurrencesOf:(Character doubleQuote)
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   809
	].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   810
	qIndex := line indexOf:(Character doubleQuote).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   811
	^ comment , Character cr asString , (line copyTo:(qIndex - 1)) withoutSpaces
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   812
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   813
    ^ nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
   814
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   815
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   816
     (Method compiledMethodAt:#methodComment) methodComment
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   817
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   818
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   819
a27a279701f8 Initial revision
claus
parents:
diff changeset
   820
referencesGlobal:aGlobalSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   821
    "return true, if this method references the global
a27a279701f8 Initial revision
claus
parents:
diff changeset
   822
     bound to aGlobalSymbol."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   823
a27a279701f8 Initial revision
claus
parents:
diff changeset
   824
    literals isNil ifTrue:[^ false].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   825
    ^ (literals identityIndexOf:aGlobalSymbol startingAt:1) ~~ 0
a27a279701f8 Initial revision
claus
parents:
diff changeset
   826
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   827
a27a279701f8 Initial revision
claus
parents:
diff changeset
   828
sends:aSelectorSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   829
    "return true, if this method contains a message-send
a27a279701f8 Initial revision
claus
parents:
diff changeset
   830
     with aSelectorSymbol as selector. 
a27a279701f8 Initial revision
claus
parents:
diff changeset
   831
     - due to the simple check in the literal array, also simple uses 
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   832
       of aSelectorSymbol as symbol will return true.
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   833
       Should ask compiler, if there is really a send."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   834
a27a279701f8 Initial revision
claus
parents:
diff changeset
   835
    ^ self referencesGlobal:aSelectorSymbol
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   836
!
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   837
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   838
isLazyMethod
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   839
    "return true, if this is a lazy method.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   840
     False is returned here - this method is redefined in LazyMethod"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   841
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   842
    ^ false
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   843
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   844
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   845
isWrapped
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   846
    "return true, if this is a wrapper method.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   847
     False is returned here - this method is redefined in WrappedMethod"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   848
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   849
    ^ false
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   850
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   851
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   852
wrapper
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   853
    "only for wrapped methods: return the wrapper.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   854
     Thats the WrapperMethod which contains myself."
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   855
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   856
    WrappedMethod allInstancesDo:[:m |
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   857
	m originalMethod == self ifTrue:[^ m].
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   858
    ].
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   859
    ^ nil
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   860
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   861
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   862
isInvalid
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   863
    "return true, if this method is not executable due to
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   864
     a (re)-compilation error. (see comment in Method>>invalidMethod)"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   865
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   866
    |m|
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   867
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   868
    m := Method compiledMethodAt:#invalidMethod.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   869
    (self code notNil and:[self code == m code]) ifTrue:[^ true].
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   870
    (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   871
    ^ false
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   872
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   873
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   874
a27a279701f8 Initial revision
claus
parents:
diff changeset
   875
!Method methodsFor:'error handling'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   876
a27a279701f8 Initial revision
claus
parents:
diff changeset
   877
invalidMethod
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   878
    "this method is triggered by the interpreter when a nil or non method
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   879
     is about to be executed.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   880
     In this case, the VM sends this to the bad method (the receiver).
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   881
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   882
     Also, the Compiler creates methods with their code/bytecode set to
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   883
     this method if - after a class change - a method cannot be compiled
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   884
     and is therefore no longer executable (for example, after an instvar
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   885
     has been removed, and a method still tries to access this instvar)
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   886
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   887
     Thus, we arrive here, when playing around in a classes methodArray,
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   888
     or compiler/runtime system is broken :-(, 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   889
     or you ignore the error messages during some recompile."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   890
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
   891
    ^ InvalidCodeSignal
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   892
	raiseRequestWith:self
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   893
	errorString:'invalid method - not executable'.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   894
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   895
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   896
wrongNumberOfArguments:numberGiven
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   897
    "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
   898
     of arguments. This only applies to #valueWithReceiverXXX - sends.
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   899
     With a normal send, this error cannot happen."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   900
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
   901
    ^ ArgumentSignal
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   902
	raiseRequestWith:self
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   903
	errorString:('method got ' , numberGiven printString ,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
   904
		     ' args while ' , self numberOfMethodArgs printString , ' where expected')
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   905
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   906
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   907
privateMethodCalled
176
48061f8659aa more queries
claus
parents: 159
diff changeset
   908
    "this error is triggered, if a private or protected method is called from
48061f8659aa more queries
claus
parents: 159
diff changeset
   909
     outside.
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
   910
     Methodprivacy is an EXPERIMENTAL feature."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   911
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
   912
    ^ PrivateMethodSignal raise
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   913
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   914
a27a279701f8 Initial revision
claus
parents:
diff changeset
   915
!Method methodsFor:'executing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   916
a27a279701f8 Initial revision
claus
parents:
diff changeset
   917
valueWithReceiver:anObject arguments:argArray
2
claus
parents: 1
diff changeset
   918
    "low level call of a methods code - BIG DANGER ALERT.
claus
parents: 1
diff changeset
   919
     Perform the receiver-method on anObject as receiver and argArray as
claus
parents: 1
diff changeset
   920
     arguments. This does NO message lookup at all and mimics a
claus
parents: 1
diff changeset
   921
     traditional function call.
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   922
     This method is provided for debugging- and breakpoint-support 
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   923
     (replacing a method by a stub and recalling the original), or to implement
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   924
     experimental MI implementations - it is not for general use. 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   925
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   926
     The receiver must be a method compiled in anObjects class or one of its 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   927
     superclasses and also, the number of arguments given must match the methods
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   928
     expectations -
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   929
     - otherwise strange things (and also strange crashes) can occur.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   930
     The system is NOT always detecting a wrong method/receiver combination.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   931
     YOU HAVE BEEN WARNED."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   932
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   933
    ^ self valueWithReceiver:anObject arguments:argArray selector:nil search:nil
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   934
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   935
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   936
valueWithReceiver:anObject arguments:argArray selector:aSymbol
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   937
    "low level call of a methods code - BIG DANGER ALERT.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   938
     Perform the receiver-method on anObject as receiver and argArray as
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   939
     arguments. This does NO message lookup at all and mimics a
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   940
     traditional function call.
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   941
     This method is provided for debugging- and breakpoint-support 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   942
     (replacing a method by a stub and recalling the original), or to implement
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   943
     experimental MI implementations - it is not for general use. 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
   944
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   945
     The receiver must be a method compiled in anObjects class or one of its 
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   946
     superclasses and also, the number of arguments given must match the methods
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   947
     expectations -
44
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   948
     - otherwise strange things (and also strange crashes) can occur.
b262907c93ea *** empty log message ***
claus
parents: 42
diff changeset
   949
     The system is NOT always detecting a wrong method/receiver combination.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   950
     YOU HAVE BEEN WARNED."
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   951
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   952
    ^ self valueWithReceiver:anObject 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   953
		   arguments:argArray 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   954
		    selector:aSymbol 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   955
		      search:nil
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   956
		      sender:nil
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   957
!
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   958
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   959
valueWithReceiver:anObject arguments:argArray selector:aSymbol search:aClass
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   960
    "low level call of a methods code - BIG DANGER ALERT.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   961
     Perform the receiver-method on anObject as receiver and argArray as
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   962
     arguments. This does NO message lookup at all and mimics a
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   963
     traditional function call.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   964
     This method is provided for debugging- and breakpoint-support 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   965
     (replacing a method by a stub and recalling the original), or to implement
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   966
     experimental MI implementations - it is not for general use. 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   967
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   968
     The receiver must be a method compiled in anObjects class or one of its 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   969
     superclasses and also, the number of arguments given must match the methods
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   970
     expectations -
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   971
     - otherwise strange things (and also strange crashes) can occur.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   972
     The system is NOT always detecting a wrong method/receiver combination.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   973
     YOU HAVE BEEN WARNED."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   974
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   975
    ^ self valueWithReceiver:anObject 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   976
		   arguments:argArray 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   977
		    selector:aSymbol 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   978
		      search:nil
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   979
		      sender:nil
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   980
!
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   981
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   982
valueWithReceiver:anObject arguments:argArray selector:aSymbol search:aClass sender:virtualSender
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   983
    "low level call of a methods code - BIG DANGER ALERT.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   984
     Perform the receiver-method on anObject as receiver and argArray as
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   985
     arguments. This does NO message lookup at all and mimics a
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   986
     traditional function call.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   987
     This method is provided for debugging- and breakpoint-support 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   988
     (replacing a method by a stub and recalling the original), or to implement
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   989
     experimental MI implementations - it is not for general use. 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   990
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   991
     The receiver must be a method compiled in anObjects class or one of its 
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   992
     superclasses and also, the number of arguments given must match the methods
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   993
     expectations -
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   994
     - otherwise strange things (and also strange crashes) can occur.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   995
     The system is NOT always detecting a wrong method/receiver combination.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   996
     YOU HAVE BEEN WARNED."
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
   997
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   998
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
   999
    OBJFUNC code;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1000
    OBJ searchClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1001
    static struct inlineCache dummy = _DUMMYILC0;
2
claus
parents: 1
diff changeset
  1002
    int nargs;
claus
parents: 1
diff changeset
  1003
    OBJ *ap;
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1004
    extern OBJ interpret();
2
claus
parents: 1
diff changeset
  1005
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1006
    if (__isArray(argArray)) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1007
	nargs = _arraySize(argArray);
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1008
	ap = _ArrayInstPtr(argArray)->a_element;
2
claus
parents: 1
diff changeset
  1009
    } else {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1010
	if (argArray == nil) {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1011
	    nargs = 0;
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1012
	} else
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1013
	    nargs = -1;
2
claus
parents: 1
diff changeset
  1014
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1015
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1016
#ifdef F_NARGS
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1017
    if (((_intVal(_INST(flags)) & F_NARGS) >> F_NARGSHIFT) == nargs) 
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1018
#endif
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1019
    {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1020
	code = _MethodInstPtr(self)->m_code;
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1021
	if (aClass == nil) {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1022
	    searchClass = dummy.ilc_class = _Class(anObject);
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1023
	} else {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1024
	    searchClass = dummy.ilc_class = aClass;
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1025
	}
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1026
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1027
	if (nargs <= 15) {
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1028
	  /*
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1029
	   * add virtual sender (unwinding) here later,
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1030
	   * to allow hiding contexts in lazy methods.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1031
	   * (this is consmetics only; therefore its done later)
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1032
	   */
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1033
	  if (code) {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1034
	    /* compiled code */
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1035
	    switch (nargs) {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1036
		case 0:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1037
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1038
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1039
		case 1:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1040
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, ap[0]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1041
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1042
		case 2:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1043
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, ap[0], ap[1]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1044
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1045
		case 3:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1046
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, ap[0], ap[1], ap[2]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1047
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1048
		case 4:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1049
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1050
				 ap[0], ap[1], ap[2], ap[3]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1051
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1052
		case 5:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1053
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1054
				 ap[0], ap[1], ap[2], ap[3], ap[4]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1055
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1056
		case 6:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1057
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1058
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1059
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1060
		case 7:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1061
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1062
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1063
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1064
		case 8:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1065
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1066
				 ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1067
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1068
		case 9:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1069
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1070
				 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
  1071
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1072
		case 10:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1073
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1074
				 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
  1075
				 ap[9]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1076
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1077
		case 11:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1078
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1079
				 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
  1080
				 ap[9], ap[10]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1081
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1082
		case 12:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1083
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1084
				 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
  1085
				 ap[9], ap[10], ap[11]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1086
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1087
		case 13:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1088
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1089
				 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
  1090
				 ap[9], ap[10], ap[11], ap[12]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1091
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1092
		case 14:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1093
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1094
				 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
  1095
				 ap[9], ap[10], ap[11], ap[12], ap[13]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1096
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1097
		case 15:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1098
		    RETURN ( (*code)(anObject, aSymbol, SND_COMMA searchClass, &dummy, 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1099
				 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
  1100
				 ap[9], ap[10], ap[11], ap[12], ap[13], ap[14]) );
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1101
	    }
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1102
	  } else {
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1103
	    /* interpreted code */
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1104
	    switch (nargs) {
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1105
		case 0:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1106
		    RETURN ( interpret(self, 0, anObject, aSymbol, SND_COMMA searchClass) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1107
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1108
		case 1:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1109
		    RETURN ( interpret(self, 1, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1110
				   ap[0]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1111
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1112
		case 2:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1113
		    RETURN ( interpret(self, 2, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1114
				   ap[0], ap[1]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1115
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1116
		case 3:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1117
		    RETURN ( interpret(self, 3, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1118
				   ap[0], ap[1], ap[2]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1119
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1120
		case 4:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1121
		    RETURN ( interpret(self, 4, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1122
				   ap[0], ap[1], ap[2], ap[3]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1123
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1124
		case 5:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1125
		    RETURN ( interpret(self, 5, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1126
				   ap[0], ap[1], ap[2], ap[3], ap[4]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1127
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1128
		case 6:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1129
		    RETURN ( interpret(self, 6, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1130
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1131
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1132
		case 7:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1133
		    RETURN ( interpret(self, 7, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1134
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1135
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1136
		case 8:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1137
		    RETURN ( interpret(self, 8, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1138
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1139
				   ap[7]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1140
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1141
		case 9:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1142
		    RETURN ( interpret(self, 9, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1143
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1144
				   ap[7], ap[8]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1145
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1146
		case 10:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1147
		    RETURN ( interpret(self, 10, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1148
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1149
				   ap[7], ap[8], ap[9]) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1150
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1151
		case 11:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1152
		    RETURN ( interpret(self, 11, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1153
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1154
				   ap[7], ap[8], ap[9], ap[10]) );
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1155
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1156
		case 12:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1157
		    RETURN ( interpret(self, 12, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1158
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1159
				   ap[7], ap[8], ap[9], ap[11]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1160
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1161
		case 13:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1162
		    RETURN ( interpret(self, 13, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1163
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1164
				   ap[7], ap[8], ap[9], ap[11], ap[12]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1165
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1166
		case 14:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1167
		    RETURN ( interpret(self, 14, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1168
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1169
				   ap[7], ap[8], ap[9], ap[11], ap[12], ap[13]) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1170
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1171
		case 15:
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1172
		    RETURN ( interpret(self, 15, anObject, aSymbol, SND_COMMA searchClass,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1173
				   ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6],
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1174
				   ap[7], ap[8], ap[9], ap[11], ap[12], ap[13], ap[14]) );
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1175
	    }
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1176
	  }
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1177
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1178
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1179
%}
2
claus
parents: 1
diff changeset
  1180
.
claus
parents: 1
diff changeset
  1181
    (argArray isMemberOf:Array) ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1182
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1183
	 arguments must be either nil or an array
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1184
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1185
	^ self badArgumentArray
2
claus
parents: 1
diff changeset
  1186
    ].
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1187
    (argArray size ~~ self numberOfMethodArgs) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1188
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1189
	 the method expects a different number of arguments
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1190
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1191
	^ self wrongNumberOfArguments:argArray size
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1192
    ].
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1193
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1194
     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
  1195
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1196
    ^ self tooManyArguments
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1197
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1198
    "
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1199
     (Float compiledMethodAt:#+) 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1200
	valueWithReceiver:1.0 arguments:#(2.0)
2
claus
parents: 1
diff changeset
  1201
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1202
     '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
  1203
     (True compiledMethodAt:#printString) 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1204
	valueWithReceiver:false arguments:nil
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1205
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1206
     '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
  1207
      and a wrong value returned ...'.
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1208
     (Point compiledMethodAt:#x) 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1209
	valueWithReceiver:(1->2) arguments:nil
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1210
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1211
     '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
  1212
      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
  1213
     (Point compiledMethodAt:#x) 
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1214
	valueWithReceiver:(Object new) arguments:nil
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1215
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1216
     '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
  1217
     (Object compiledMethodAt:#printOn:)
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1218
	valueWithReceiver:false arguments:nil
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1219
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1220
     '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
  1221
     (Object compiledMethodAt:#printOn:)
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1222
	valueWithReceiver:false arguments:#() 
109
1fae65190b17 errors raise signals; check arg-count in valueWith...
claus
parents: 93
diff changeset
  1223
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1224
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1225
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1226
!Method methodsFor:'printing & storing'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1227
275
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1228
whoString
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1229
    "return a string as className>>selector, if this is not an unbound
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1230
     method. Otherwise return 'unbound'. Used with debugging."
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1231
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1232
    |w|
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1233
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1234
    w := self who.
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1235
    w notNil ifTrue:[
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1236
	^ (w at:1) name , '>>' , (w at:2)
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1237
    ].
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1238
    ^ 'unbound'
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1239
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1240
    "
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1241
     Method new whoString
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1242
     (Method compiledMethodAt:#whoString) whoString
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1243
    "
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1244
!
a76029ddaa98 *** empty log message ***
claus
parents: 259
diff changeset
  1245
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1246
printOn:aStream
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1247
    "put a printed representation of the receiver onto aStream.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1248
     Since methods do not store their class/selector, we have to search
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1249
     for it here."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1250
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1251
    |classAndSelector m wrapped|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1252
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1253
    wrapped := false.
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1254
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1255
    aStream nextPutAll:(self classNameWithArticle).
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1256
    aStream nextPut:$(.
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1257
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1258
    classAndSelector := self who.
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1259
    classAndSelector isNil ifTrue:[
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1260
	"
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1261
	 not anchored in any class.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1262
	 check if wrapped (to be more informative in inspectors)
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1263
	"
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1264
	m := self wrapper.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1265
	m notNil ifTrue:[
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1266
	    classAndSelector := m who.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1267
	    wrapped := true.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1268
	]
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1269
    ].
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1270
    classAndSelector notNil ifTrue:[
48061f8659aa more queries
claus
parents: 159
diff changeset
  1271
	(classAndSelector at:1) name printOn:aStream.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1272
	aStream nextPutAll:' '.
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1273
	(classAndSelector at:2) printOn:aStream.
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1274
	wrapped ifTrue:[
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1275
	    aStream nextPutAll:'; wrapped'
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1276
	].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1277
    ] ifFalse:[
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
  1278
	"
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1279
	 sorry, a method which is nowhere anchored
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 192
diff changeset
  1280
	"
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1281
	aStream nextPutAll:'unbound'
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1282
    ].
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1283
    aStream nextPut:$)
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1284
48061f8659aa more queries
claus
parents: 159
diff changeset
  1285
    "
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1286
     (Object compiledMethodAt:#at:) printOn:Transcript. Transcript cr.
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1287
     (Object compiledMethodAt:#at:) copy printOn:Transcript. Transcript cr.
176
48061f8659aa more queries
claus
parents: 159
diff changeset
  1288
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1289
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1290
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1291
!Method class methodsFor:'binary storage'!
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1292
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1293
binaryDefinitionFrom: stream manager: manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1294
    "read my definition from stream."
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1295
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1296
    |cls sel|
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1297
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1298
    "type-byte"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1299
    stream nextByte == 0 ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1300
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1301
	 built-in method
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1302
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1303
	cls := manager nextObject.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1304
	sel := manager nextObject.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1305
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1306
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1307
	 mhmh - on the source system, this was a machinecode
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1308
	 method, while here its an interpreted one ...
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1309
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1310
	cls isLoaded ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1311
	    cls autoload
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1312
	].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1313
	^ cls compiledMethodAt:sel
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1314
    ].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1315
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1316
     bytecode method
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1317
    "
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1318
    ^ super binaryDefinitionFrom:stream manager:manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1319
! !
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1320
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1321
!Method methodsFor:'binary storage'!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1322
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1323
asByteCodeMethod
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1324
    "if the receiver has no bytecodes, create & return a method having
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1325
     the same semantics as the receiver, but uses interpreted bytecodes.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1326
     Otherwise, return the receiver. The new method is not installed in
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1327
     the methodDictionary of any class - just returned.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1328
     Can be used to obtain a bytecode version of a machine-code method 
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1329
     for binary storage or dynamic recompilation (which is not yet finished)."
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1330
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1331
    |temporaryMethod cls sourceString upd silent lazy|
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1332
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1333
    byteCode notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1334
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1335
	 is already a bytecoded method
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1336
	"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1337
	^ self
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1338
    ].
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1339
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1340
    cls := self containingClass.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1341
    cls isNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1342
	'cannot generate bytecode (no class for compilation)' errorPrintNL.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1343
	^ nil
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1344
    ].
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1345
    sourceString := self source.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1346
    sourceString isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1347
	'cannot generate bytecode (no source for compilation)' errorPrintNL.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1348
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1349
    ].
227
23b1c4de3402 package & cleanup
claus
parents: 216
diff changeset
  1350
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1351
    "
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1352
     dont want this to go into the changes file,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1353
     dont want output on Transcript and definitely 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1354
     dont want a lazy method ...
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1355
    "
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1356
    upd := Class updateChanges:false.
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1357
    silent := Smalltalk silentLoading:true.
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1358
    lazy := Compiler compileLazy:false.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1359
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1360
    [
253
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1361
	temporaryMethod := cls compilerClass
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1362
				 compile:sourceString
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1363
				 forClass:cls
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1364
				 inCategory:(self category)
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1365
				 notifying:nil
30daee717a53 *** empty log message ***
claus
parents: 227
diff changeset
  1366
				 install:false.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1367
    ] valueNowOrOnUnwindDo:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1368
	Class updateChanges:upd.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1369
	Compiler compileLazy:lazy.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1370
	Smalltalk silentLoading:silent.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1371
    ].
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1372
    (temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1373
	'cannot generate bytecode (contains primitive code or error)' errorPrintNL.
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1374
	^ nil.
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1375
    ].
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1376
    "
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1377
     try to save a bit of memory, by sharing the source (whatever it is)
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1378
    "
192
3b0eb8864842 *** empty log message ***
claus
parents: 176
diff changeset
  1379
    temporaryMethod sourceFilename:source position:sourcePosition. 
142
c7844287bddf *** empty log message ***
claus
parents: 109
diff changeset
  1380
    ^ temporaryMethod
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1381
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1382
    "
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1383
     (LargeInteger compiledMethodAt:#normalize) asByteCodeMethod
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1384
     (SmallInteger compiledMethodAt:#+) asByteCodeMethod  
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1385
    "
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1386
!
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1387
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1388
storeBinaryDefinitionOn:stream manager:manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1389
    "only store bytecode-methods - machinecode methods are stored
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1390
     as class/selector pair and a lookup is done when restored.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1391
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1392
     If the receiver method is a built-in (i.e. machine coded)
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1393
     method, a temporary interpreted byte code method is created,
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1394
     and its bytecode stored. 
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1395
     This works only, if the source of the method is available and the
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
  1396
     method does not contain primitive code."
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1397
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1398
    |storedMethod who|
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1399
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1400
    byteCode isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1401
	self code notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1402
	    (who := self who) notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1403
		"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1404
		 machine code only - assume its a built-in method,
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1405
		 and store the class/selector information.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1406
		 The restored method may not be exactly the same ...
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1407
		"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1408
		manager putIdOf:(self class) on:stream.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1409
		stream nextPutByte:0.   "means built-in method" 
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1410
		manager putIdOf:(who at:1) on:stream.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1411
		manager putIdOf:(who at:2) on:stream.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1412
		^ self
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1413
	    ]
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1414
	].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1415
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1416
	storedMethod := self asByteCodeMethod.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1417
	storedMethod isNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1418
	    self error:'store of built-in method failed'.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1419
	    ^ nil
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1420
	].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1421
	^ storedMethod storeBinaryDefinitionOn:stream manager:manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1422
    ].
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1423
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1424
    manager putIdOf:(self class) on:stream.
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1425
    stream nextPutByte:1.       "means byte-coded method"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1426
    self storeBinaryDefinitionBodyOn:stream manager:manager
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1427
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1428
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1429
readBinaryContentsFrom: stream manager: manager
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1430
    "tell the newly restored Font about restoration"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1431
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1432
    self code notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1433
	"built-in method - already complete"
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1434
	^ self
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1435
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1436
159
514c749165c3 *** empty log message ***
claus
parents: 142
diff changeset
  1437
    ^ super readBinaryContentsFrom: stream manager: manager
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1438
! !