Behavior.st
author Claus Gittinger <cg@exept.de>
Wed, 03 Apr 1996 00:06:56 +0200
changeset 1133 961f2b095c22
parent 1088 989f0e510a32
child 1179 3e0f32177af4
permissions -rw-r--r--
underline cleanup
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) 1988 by Claus Gittinger
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
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
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
Object subclass:#Behavior
1088
989f0e510a32 nicer message
Claus Gittinger <cg@exept.de>
parents: 983
diff changeset
    14
	instanceVariableNames:'superclass flags selectorArray methodArray otherSuperclasses
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
    15
		instSize'
1088
989f0e510a32 nicer message
Claus Gittinger <cg@exept.de>
parents: 983
diff changeset
    16
	classVariableNames:'SubclassInfo'
989f0e510a32 nicer message
Claus Gittinger <cg@exept.de>
parents: 983
diff changeset
    17
	poolDictionaries:''
989f0e510a32 nicer message
Claus Gittinger <cg@exept.de>
parents: 983
diff changeset
    18
	category:'Kernel-Classes'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    21
!Behavior class methodsFor:'documentation'!
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    22
88
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    23
copyright
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    24
"
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    25
 COPYRIGHT (c) 1988 by Claus Gittinger
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    26
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    27
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    28
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    29
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    31
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    32
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    33
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    34
"
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    35
!
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    36
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    37
documentation
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    38
"
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    39
    Every class in the system inherits from Behavior (via Class, ClassDescription);
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    40
    so here is where most of the class messages end up being implemented.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    41
    (to answer a FAQ: 'Point basicNew' will be done here :-)
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    42
356
claus
parents: 345
diff changeset
    43
    Beginners should keep in mind, that all classes are instances (of subclasses)
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
    44
    of Behavior, therefore you will find the above mentioned 'basicNew:' method 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
    45
    under the 'instance'-methods of Behavior - NOT under the class methods 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    46
    ('Behavior new' will create and return a new class, while sending 'new' to 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    47
    any instance of Behavior (i.e. any class) will return an instance of that class).
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    48
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    49
    Behavior provides minimum support for all classes - additional stuff is
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
    50
    found in ClassDescription and Class. Behaviors provides all mechanisms needed
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
    51
    to create instances, and send messages to those. However, Behavior does not provide 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
    52
    all the (symbolic) information needed to compile methods for a class or to get
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
    53
    useful information in inspectors.
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    54
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    55
    In contrast to other ST implementations, the methods have been separated
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    56
    from the selectors (there is no Dictionary, but two separate Arrays)
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    57
    - this avoids the need for knowledge about Dictionaries in the runtime library (VM)
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    58
    (lookup and search in these is seldom anyway, so the added benefit from using a 
356
claus
parents: 345
diff changeset
    59
     hashed dictionary is almost void). 
claus
parents: 345
diff changeset
    60
    For ST-80 compatibility, this will be replaced by a single instance of
362
claus
parents: 360
diff changeset
    61
    MethodDictionary (which will NOT be a true dictionary, but an Array with
356
claus
parents: 345
diff changeset
    62
    alternating selector/method entries).
claus
parents: 345
diff changeset
    63
    To be prepared for this change, please do NOT directly use the methodArray 
claus
parents: 345
diff changeset
    64
    and selectorArray instVars.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    65
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    66
    Instance variables:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    68
	superclass        <Class>           the receivers superclass
356
claus
parents: 345
diff changeset
    69
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    70
	otherSuperclasses <Array of Class>  experimental: other superclasses
356
claus
parents: 345
diff changeset
    71
					    a hook for experimental multiple inheritance
claus
parents: 345
diff changeset
    72
					    implementations
claus
parents: 345
diff changeset
    73
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    74
	selectorArray     <Array of Symbol> the selectors for which inst-methods are defined here
356
claus
parents: 345
diff changeset
    75
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    76
	methodArray       <Array of Method> the inst-methods corresponding to the selectors
356
claus
parents: 345
diff changeset
    77
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    78
	instSize          <SmallInteger>    the number of instance variables
356
claus
parents: 345
diff changeset
    79
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    80
	flags             <SmallInteger>    special flag bits coded in a number
356
claus
parents: 345
diff changeset
    81
					    not for application use
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    82
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
    83
    flag bits (see stc.h):
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    84
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    85
    NOTICE: layout known by compiler and runtime system; be careful when changing
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    86
"
356
claus
parents: 345
diff changeset
    87
!
claus
parents: 345
diff changeset
    88
claus
parents: 345
diff changeset
    89
virtualMachineRelationship 
claus
parents: 345
diff changeset
    90
"
357
claus
parents: 356
diff changeset
    91
    NOTICE: 
claus
parents: 356
diff changeset
    92
	the stuff described below may not be available on other
claus
parents: 356
diff changeset
    93
	Smalltalk implementations; be aware that these error mechanisms
claus
parents: 356
diff changeset
    94
	are ST/X specials and applications using these (tricks) may
claus
parents: 356
diff changeset
    95
	not be portable to other systems.
claus
parents: 356
diff changeset
    96
claus
parents: 356
diff changeset
    97
    WARNING: 
claus
parents: 356
diff changeset
    98
	do not try the examples below on (some) other smalltalk systems;
claus
parents: 356
diff changeset
    99
	it has been reported, that some crash badly when doing this .... ;-)
claus
parents: 356
diff changeset
   100
356
claus
parents: 345
diff changeset
   101
    Instances of Behavior and subclasses (i.e. in sloppy words: classes)
claus
parents: 345
diff changeset
   102
    play a special role w.r.t. the VM. Only objects whose class-slot is marked
claus
parents: 345
diff changeset
   103
    as being behaviorLike (in the flag-instvar) are considered to be classLike
claus
parents: 345
diff changeset
   104
    and a message lookup will be done for it in the well known way.
claus
parents: 345
diff changeset
   105
    Thus, if an object has a class for which its class does NOT have
362
claus
parents: 360
diff changeset
   106
    this flag bit set, the VM will trigger an error on a message send.
356
claus
parents: 345
diff changeset
   107
claus
parents: 345
diff changeset
   108
    Why is this so:
claus
parents: 345
diff changeset
   109
claus
parents: 345
diff changeset
   110
    the above lets every object play the role of a class,
claus
parents: 345
diff changeset
   111
    which has been flagged as behaviorLike in its class's flag.
claus
parents: 345
diff changeset
   112
    Thus, you can create arbitrary new classLike objects and have the VM 
claus
parents: 345
diff changeset
   113
    play with them.
claus
parents: 345
diff changeset
   114
    This may offer the flexibility to create a totally different object scheme
362
claus
parents: 360
diff changeset
   115
    on top of ST/X (for example: Self like objects) where any object can play
claus
parents: 360
diff changeset
   116
    a classRole for another object.
356
claus
parents: 345
diff changeset
   117
357
claus
parents: 356
diff changeset
   118
    However, the VM trusts the isBehaviorLike flag - if it is set for some
362
claus
parents: 360
diff changeset
   119
    object, it expects the object selector and methodDictionaries to be found
claus
parents: 360
diff changeset
   120
    at the instance positions as defined here.
claus
parents: 360
diff changeset
   121
    (i.e. instanceVariables with contents and semantic corresponding to
claus
parents: 360
diff changeset
   122
	superclass flags selectorArray methodArray
claus
parents: 360
diff changeset
   123
     must be present and have the same instVar-index as here).
claus
parents: 360
diff changeset
   124
356
claus
parents: 345
diff changeset
   125
    The VM (and the system) may crash badly, if this is not the case.
362
claus
parents: 360
diff changeset
   126
356
claus
parents: 345
diff changeset
   127
    Since every class in the system derives from Behavior, the flag setting
357
claus
parents: 356
diff changeset
   128
    (and instance variable layout) is correct for all 'normal' classes.
claus
parents: 356
diff changeset
   129
    If you experiment by creating new behaviorLike objects, please take
claus
parents: 356
diff changeset
   130
    care of this flag. If you want to use the VM's lookup function, the
claus
parents: 356
diff changeset
   131
    instVars  'superclass', 'selectorArray' and 'methodArray' are required
claus
parents: 356
diff changeset
   132
    and have to be at the same instVar index.
362
claus
parents: 360
diff changeset
   133
    (we suggest, you subclass Behavior, to make certain)
357
claus
parents: 356
diff changeset
   134
claus
parents: 356
diff changeset
   135
    You do not have to care about the above details if you are a 'normal'
claus
parents: 356
diff changeset
   136
    ST-programmer, though.
claus
parents: 356
diff changeset
   137
356
claus
parents: 345
diff changeset
   138
759
908363ce8a32 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   139
    Examples (only of theoretical interest):
356
claus
parents: 345
diff changeset
   140
	take away the behaviorLike-flag from a class.
claus
parents: 345
diff changeset
   141
	-> The instances will not understand any messages, since the VM will
claus
parents: 345
diff changeset
   142
	   not recognize its class as being a class ...
claus
parents: 345
diff changeset
   143
claus
parents: 345
diff changeset
   144
	|newMeta notRecognizedAsClass someInstance|
claus
parents: 345
diff changeset
   145
claus
parents: 345
diff changeset
   146
	newMeta := Metaclass new.
claus
parents: 345
diff changeset
   147
	newMeta flags:0.
claus
parents: 345
diff changeset
   148
claus
parents: 345
diff changeset
   149
	notRecognizedAsClass := newMeta new.
claus
parents: 345
diff changeset
   150
claus
parents: 345
diff changeset
   151
	someInstance := notRecognizedAsClass new.
claus
parents: 345
diff changeset
   152
	someInstance perform:#isNil
claus
parents: 345
diff changeset
   153
357
claus
parents: 356
diff changeset
   154
claus
parents: 356
diff changeset
   155
    Of course, this is an exception which can be handled ...:
claus
parents: 356
diff changeset
   156
    Example:
claus
parents: 356
diff changeset
   157
claus
parents: 356
diff changeset
   158
	|newMeta notRecognizedAsClass someInstance|
claus
parents: 356
diff changeset
   159
claus
parents: 356
diff changeset
   160
	newMeta := Metaclass new.
claus
parents: 356
diff changeset
   161
	newMeta flags:0.
claus
parents: 356
diff changeset
   162
claus
parents: 356
diff changeset
   163
	notRecognizedAsClass := newMeta new.
claus
parents: 356
diff changeset
   164
claus
parents: 356
diff changeset
   165
	someInstance := notRecognizedAsClass new.
claus
parents: 356
diff changeset
   166
	Object errorSignal handle:[:ex |
claus
parents: 356
diff changeset
   167
	    ex return
claus
parents: 356
diff changeset
   168
	] do:[
claus
parents: 356
diff changeset
   169
	    someInstance perform:#isNil
claus
parents: 356
diff changeset
   170
	]
claus
parents: 356
diff changeset
   171
claus
parents: 356
diff changeset
   172
claus
parents: 356
diff changeset
   173
    likewise, a doesNotUnderstand-notUnderstood can be handled:
claus
parents: 356
diff changeset
   174
    Example:
claus
parents: 356
diff changeset
   175
claus
parents: 356
diff changeset
   176
	|newMeta funnyClass someInstance|
claus
parents: 356
diff changeset
   177
claus
parents: 356
diff changeset
   178
	newMeta := Metaclass new.
claus
parents: 356
diff changeset
   179
claus
parents: 356
diff changeset
   180
	funnyClass := newMeta new.
claus
parents: 356
diff changeset
   181
	funnyClass setSuperclass:nil.
claus
parents: 356
diff changeset
   182
claus
parents: 356
diff changeset
   183
	someInstance := funnyClass new.
claus
parents: 356
diff changeset
   184
	Object errorSignal handle:[:ex |
claus
parents: 356
diff changeset
   185
	     ex return
claus
parents: 356
diff changeset
   186
	] do:[
claus
parents: 356
diff changeset
   187
	    someInstance perform:#isNil
claus
parents: 356
diff changeset
   188
	]
claus
parents: 356
diff changeset
   189
claus
parents: 356
diff changeset
   190
362
claus
parents: 360
diff changeset
   191
    more examples, which try to trick the VM ;-):
357
claus
parents: 356
diff changeset
   192
	badly playing around with a classes internals ...
claus
parents: 356
diff changeset
   193
claus
parents: 356
diff changeset
   194
	|newClass someInstance|
claus
parents: 356
diff changeset
   195
claus
parents: 356
diff changeset
   196
	newClass := Class new.
claus
parents: 356
diff changeset
   197
	newClass setSelectorArray:nil.
claus
parents: 356
diff changeset
   198
	someInstance := newClass new.
claus
parents: 356
diff changeset
   199
	someInstance inspect
claus
parents: 356
diff changeset
   200
claus
parents: 356
diff changeset
   201
claus
parents: 356
diff changeset
   202
	|newClass someInstance|
claus
parents: 356
diff changeset
   203
claus
parents: 356
diff changeset
   204
	newClass := Class new.
claus
parents: 356
diff changeset
   205
	newClass setSuperclass:nil.
claus
parents: 356
diff changeset
   206
	someInstance := newClass new.
claus
parents: 356
diff changeset
   207
	someInstance inspect
claus
parents: 356
diff changeset
   208
claus
parents: 356
diff changeset
   209
claus
parents: 356
diff changeset
   210
	|newClass someInstance|
claus
parents: 356
diff changeset
   211
claus
parents: 356
diff changeset
   212
	newClass := Class new.
claus
parents: 356
diff changeset
   213
	newClass setSuperclass:newClass.
claus
parents: 356
diff changeset
   214
	someInstance := newClass new.
claus
parents: 356
diff changeset
   215
	someInstance inspect
claus
parents: 356
diff changeset
   216
claus
parents: 356
diff changeset
   217
claus
parents: 356
diff changeset
   218
	|newClass someInstance|
claus
parents: 356
diff changeset
   219
claus
parents: 356
diff changeset
   220
	newClass := Class new.
claus
parents: 356
diff changeset
   221
	newClass setSuperclass:1.
claus
parents: 356
diff changeset
   222
	someInstance := newClass new.
claus
parents: 356
diff changeset
   223
	someInstance inspect
claus
parents: 356
diff changeset
   224
claus
parents: 356
diff changeset
   225
356
claus
parents: 345
diff changeset
   226
    Example:
claus
parents: 345
diff changeset
   227
	creating totally anonymous classes:
claus
parents: 345
diff changeset
   228
claus
parents: 345
diff changeset
   229
	|newClass someInstance|
claus
parents: 345
diff changeset
   230
claus
parents: 345
diff changeset
   231
	newClass := Class new.
claus
parents: 345
diff changeset
   232
	someInstance := newClass new.
claus
parents: 345
diff changeset
   233
	someInstance inspect
claus
parents: 345
diff changeset
   234
357
claus
parents: 356
diff changeset
   235
356
claus
parents: 345
diff changeset
   236
    Example:
357
claus
parents: 356
diff changeset
   237
	creating totally anonymous metaclasses:
356
claus
parents: 345
diff changeset
   238
claus
parents: 345
diff changeset
   239
	|newMeta newClass someInstance|
claus
parents: 345
diff changeset
   240
claus
parents: 345
diff changeset
   241
	newMeta := Metaclass new.
claus
parents: 345
diff changeset
   242
	newClass := newMeta new.
claus
parents: 345
diff changeset
   243
	someInstance := newClass new.
claus
parents: 345
diff changeset
   244
	someInstance inspect
357
claus
parents: 356
diff changeset
   245
claus
parents: 356
diff changeset
   246
    PS: if you experiment with new behaviorLike objects, you may want 
claus
parents: 356
diff changeset
   247
	to turn off the VM's debugPrintouts
claus
parents: 356
diff changeset
   248
	with: 
claus
parents: 356
diff changeset
   249
		'Smalltalk debugPrinting:false'
claus
parents: 356
diff changeset
   250
	and: 
claus
parents: 356
diff changeset
   251
		'Smalltalk infoPrinting:false'
356
claus
parents: 345
diff changeset
   252
"
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
   253
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   254
a27a279701f8 Initial revision
claus
parents:
diff changeset
   255
!Behavior class methodsFor:'creating new classes'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   256
a27a279701f8 Initial revision
claus
parents:
diff changeset
   257
new
356
claus
parents: 345
diff changeset
   258
    "creates and return a new behavior (which is like a class,
claus
parents: 345
diff changeset
   259
     but without the symbolic & name information).
claus
parents: 345
diff changeset
   260
     Not for normal applications.
claus
parents: 345
diff changeset
   261
     Sending the returned behavior the #new message gives you
claus
parents: 345
diff changeset
   262
     an instance if it.
claus
parents: 345
diff changeset
   263
claus
parents: 345
diff changeset
   264
     Notice: the returned class is given a superclass of Object;
claus
parents: 345
diff changeset
   265
     this allows for its new instances to be inspected and the like."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   266
a27a279701f8 Initial revision
claus
parents:
diff changeset
   267
    |newClass|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   268
a27a279701f8 Initial revision
claus
parents:
diff changeset
   269
    newClass := self basicNew.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   270
    newClass setSuperclass:Object
345
claus
parents: 343
diff changeset
   271
		 selectors:#() "/ (Array new:0)
claus
parents: 343
diff changeset
   272
		   methods:#() "/ (Array new:0)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   273
		  instSize:0
345
claus
parents: 343
diff changeset
   274
		     flags:(self flagBehavior).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   275
    ^ newClass
356
claus
parents: 345
diff changeset
   276
claus
parents: 345
diff changeset
   277
    "
claus
parents: 345
diff changeset
   278
     Behavior new               <- a new behavior
claus
parents: 345
diff changeset
   279
     Behavior new new           <- an instance of it
claus
parents: 345
diff changeset
   280
     ClassDescription new       <- a new classDescription
claus
parents: 345
diff changeset
   281
     ClassDescription new new   <- an instance of it
claus
parents: 345
diff changeset
   282
     Class new                  <- a new class
claus
parents: 345
diff changeset
   283
     Class new new              <- an instance of it
claus
parents: 345
diff changeset
   284
     Metaclass new              <- a new metaclass
claus
parents: 345
diff changeset
   285
     Metaclass new new          <- an instance (i.e. a class) of it
claus
parents: 345
diff changeset
   286
     Metaclass new new new      <- an instance of this new class
claus
parents: 345
diff changeset
   287
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   288
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   289
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   290
!Behavior class methodsFor:'flag bit constants'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   291
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   292
flagBehavior
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   293
    "return the flag code which marks Behavior-like instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   294
     You have to check this single bit in the flag value when
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   295
     checking for behaviors."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   296
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   297
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   298
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   299
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   300
    RETURN ( __MKSMALLINT(BEHAVIOR_INSTS) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   301
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   302
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   303
    "consistency check:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   304
     all class-entries must be behaviors;
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   305
     all behaviors must be flagged so (in its class's flags)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   306
     (otherwise, VM will bark)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   307
     all non-behaviors may not be flagged
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   308
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   309
     |bit|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   310
     bit := Class flagBehavior.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   311
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   312
     ObjectMemory allObjectsDo:[:o|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   313
       o isBehavior ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   314
	 (o class flags bitTest:bit) ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   315
	     self halt
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   316
	 ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   317
       ] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   318
	 (o class flags bitTest:bit) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   319
	     self halt
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   320
	 ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   321
       ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   322
       o class isBehavior ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   323
	 self halt
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   324
       ] ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   325
	 (o class class flags bitTest:bit) ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   326
	     self halt
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   327
	 ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   328
       ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   329
     ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   330
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   331
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   332
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   333
flagBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   334
    "return the flag code which marks Block-like instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   335
     You have to check this single bit in the flag value when
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   336
     checking for blocks."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   337
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   338
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   339
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   340
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   341
    RETURN ( __MKSMALLINT(BLOCK_INSTS) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   342
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   343
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   344
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   345
flagBlockContext
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   346
    "return the flag code which marks BlockContext-like instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   347
     You have to check this single bit in the flag value when
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   348
     checking for blockContexts."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   349
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   350
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   351
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   352
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   353
    RETURN ( __MKSMALLINT(BCONTEXT_INSTS) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   354
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   355
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   356
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   357
flagBytes
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   358
    "return the flag code for byte-valued indexed instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   359
     You have to mask the flag value with indexMask when comparing
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   360
     it with flagBytes."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   361
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   362
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   363
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   364
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   365
    RETURN ( __MKSMALLINT(BYTEARRAY) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   366
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   367
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   368
     Behavior flagBytes    
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   369
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   370
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   371
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   372
flagContext
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   373
    "return the flag code which marks Context-like instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   374
     You have to check this single bit in the flag value when
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   375
     checking for contexts."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   376
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   377
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   378
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   379
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   380
    RETURN ( __MKSMALLINT(CONTEXT_INSTS) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   381
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   382
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   383
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   384
flagDoubles
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   385
    "return the flag code for double-valued indexed instances (i.e. 8-byte reals).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   386
     You have to mask the flag value with indexMask when comparing
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   387
     it with flagDoubles."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   388
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   389
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   390
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   391
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   392
    RETURN ( __MKSMALLINT(DOUBLEARRAY) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   393
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   394
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   395
     Behavior flagDoubles    
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   396
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   397
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   398
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   399
flagFloat
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   400
    "return the flag code which marks Float-like instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   401
     You have to check this single bit in the flag value when
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   402
     checking for floats."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   403
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   404
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   405
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   406
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   407
    RETURN ( __MKSMALLINT(FLOAT_INSTS) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   408
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   409
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   410
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   411
flagFloats
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   412
    "return the flag code for float-valued indexed instances (i.e. 4-byte reals).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   413
     You have to mask the flag value with indexMask when comparing
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   414
     it with flagFloats."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   415
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   416
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   417
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   418
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   419
    RETURN ( __MKSMALLINT(FLOATARRAY) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   420
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   421
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   422
     Behavior flagFloats    
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   423
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   424
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   425
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   426
flagLongs
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   427
    "return the flag code for long-valued indexed instances (i.e. 4-byte).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   428
     You have to mask the flag value with indexMask when comparing
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   429
     it with flagLongs."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   430
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   431
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   432
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   433
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   434
    RETURN ( __MKSMALLINT(LONGARRAY) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   435
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   436
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   437
     Behavior flagLongs    
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   438
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   439
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   440
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   441
flagMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   442
    "return the flag code which marks Method-like instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   443
     You have to check this single bit in the flag value when
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   444
     checking for methods."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   445
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   446
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   447
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   448
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   449
    RETURN ( __MKSMALLINT(METHOD_INSTS) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   450
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   451
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   452
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   453
flagNonObjectInst
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   454
    "return the flag code which marks instances which have a
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   455
     non-object instance variable (in slot 1).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   456
     (these are ignored by the garbage collector)"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   457
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   458
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   459
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   460
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   461
    RETURN ( __MKSMALLINT(NONOBJECT_INSTS) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   462
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   463
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   464
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   465
flagNotIndexed
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   466
    "return the flag code for non-indexed instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   467
     You have to mask the flag value with indexMask when comparing
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   468
     it with flagNotIndexed."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   469
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   470
    ^ 0
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   471
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   472
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   473
flagPointers
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   474
    "return the flag code for pointer indexed instances (i.e. Array of object).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   475
     You have to mask the flag value with indexMask when comparing
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   476
     it with flagPointers."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   477
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   478
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   479
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   480
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   481
    RETURN ( __MKSMALLINT(POINTERARRAY) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   482
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   483
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   484
     Behavior flagPointers    
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   485
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   486
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   487
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   488
flagSymbol
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   489
    "return the flag code which marks Symbol-like instances.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   490
     You have to check this single bit in the flag value when
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   491
     checking for symbols."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   492
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   493
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   494
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   495
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   496
    RETURN ( __MKSMALLINT(SYMBOL_INSTS) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   497
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   498
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   499
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   500
flagWeakPointers
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   501
    "return the flag code for weak pointer indexed instances (i.e. WeakArray).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   502
     You have to mask the flag value with indexMask when comparing
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   503
     it with flagWeakPointers."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   504
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   505
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   506
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   507
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   508
    RETURN ( __MKSMALLINT(WKPOINTERARRAY) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   509
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   510
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   511
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   512
flagWords
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   513
    "return the flag code for word-valued indexed instances (i.e. 2-byte).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   514
     You have to mask the flag value with indexMask when comparing
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   515
     it with flagWords."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   516
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   517
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   518
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   519
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   520
    RETURN ( __MKSMALLINT(WORDARRAY) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   521
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   522
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   523
     Behavior flagWords    
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   524
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   525
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   526
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   527
maskIndexType
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   528
    "return a mask to extract all index-type bits"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   529
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   530
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   531
    /* this is defined as a primitive to get defines from stc.h */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   532
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
   533
    RETURN ( __MKSMALLINT(ARRAYMASK) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   534
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   535
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   536
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   537
!Behavior class methodsFor:'private '!
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   538
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   539
flushSubclassInfo
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   540
    SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   541
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   542
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   543
     Class flushSubclassInfo
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   544
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   545
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   546
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   547
subclassInfo
357
claus
parents: 356
diff changeset
   548
    |d|
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   549
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   550
    SubclassInfo notNil ifTrue:[^ SubclassInfo].
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   551
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   552
    d := IdentityDictionary new.
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   553
    Smalltalk allClassesDo:[:aClass |
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   554
	|superCls|
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   555
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   556
	aClass isMeta not ifTrue:[
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   557
	    superCls := aClass superclass.
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   558
	    superCls notNil ifTrue:[
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   559
		(d includesKey: superCls) ifFalse:[
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   560
		    d at:superCls put:(Set with:aClass).
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   561
		] ifTrue:[
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   562
		    (d at:superCls ) add:aClass
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   563
		]
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   564
	    ]
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   565
	].
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   566
    ].
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   567
    SubclassInfo := d.
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   568
    ^ d
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   569
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   570
    "
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   571
     Class subclassInfo
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   572
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   573
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   574
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   575
!Behavior class methodsFor:'queries'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   576
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   577
isBuiltInClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   578
    "this class is known by the run-time-system"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   579
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   580
    ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   581
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   582
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   583
!Behavior methodsFor:'accessing'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   584
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   585
addSelector:newSelector withLazyMethod:newMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   586
    "add the method given by 2nd argument under the selector given by
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   587
     1st argument to the methodDictionary. 
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   588
     Since it does not normally flush any caches,
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   589
     this is only allowed for lazy methods (which are for a new class)."
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   590
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   591
    |oldMethod|
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   592
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   593
    newMethod isLazyMethod ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   594
	self error:'operation only allowed for lazy methods'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   595
	^ false
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   596
    ].
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   597
    oldMethod := self compiledMethodAt:newSelector.
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   598
    "/
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   599
    "/ oops: we must flush, if this method already exists ...
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   600
    "/ otherwise, the old method would still be executed out of the caches.
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   601
    "/
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   602
    oldMethod notNil ifTrue:[
746
31f5d9af5680 dont forget privace & restricted when entering a method
Claus Gittinger <cg@exept.de>
parents: 734
diff changeset
   603
	newMethod privacy:(oldMethod privacy).
31f5d9af5680 dont forget privace & restricted when entering a method
Claus Gittinger <cg@exept.de>
parents: 734
diff changeset
   604
	newMethod restricted:(oldMethod isRestricted).
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   605
	ObjectMemory flushCaches
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   606
    ].
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   607
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   608
    (self primAddSelector:newSelector withMethod:newMethod) ifTrue:[
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   609
	"/
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   610
	"/ pass the selector AND the old method as changeArg
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   611
	"/ - this allows for watchers to find out if its a new method or a method-change
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   612
	"/
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   613
	self changed:#methodDictionary with:(Array with:newSelector with:oldMethod).
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   614
	^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   615
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   616
    ^ false
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   617
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   618
    "Modified: 11.12.1995 / 13:57:17 / cg"
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   619
!
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   620
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   621
addSelector:newSelector withMethod:newMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   622
    "add the method given by 2nd argument under the selector given by
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   623
     1st argument to the methodDictionary. Flushes all caches."
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   624
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   625
    |nargs oldMethod|
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   626
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   627
    oldMethod := self compiledMethodAt:newSelector.
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   628
    (self primAddSelector:newSelector withMethod:newMethod) ifFalse:[^ false].
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   629
746
31f5d9af5680 dont forget privace & restricted when entering a method
Claus Gittinger <cg@exept.de>
parents: 734
diff changeset
   630
    oldMethod notNil ifTrue:[
31f5d9af5680 dont forget privace & restricted when entering a method
Claus Gittinger <cg@exept.de>
parents: 734
diff changeset
   631
	newMethod privacy:(oldMethod privacy).
31f5d9af5680 dont forget privace & restricted when entering a method
Claus Gittinger <cg@exept.de>
parents: 734
diff changeset
   632
	newMethod restricted:(oldMethod isRestricted).
31f5d9af5680 dont forget privace & restricted when entering a method
Claus Gittinger <cg@exept.de>
parents: 734
diff changeset
   633
    ].
31f5d9af5680 dont forget privace & restricted when entering a method
Claus Gittinger <cg@exept.de>
parents: 734
diff changeset
   634
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   635
    "/
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   636
    "/ pass the selector AND the old method as changeArg
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   637
    "/ - this allows for watchers to find out if its a new method or a method-change
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   638
    "/
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   639
    self changed:#methodDictionary with:(Array with:newSelector with:oldMethod).
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   640
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   641
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   642
     if I have no subclasses, all we have to flush is cached
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   643
     data for myself ... (actually, in any case all that needs
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   644
     to be flushed is info for myself and all of my subclasses)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   645
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   646
"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   647
    problem: this is slower; since looking for all subclasses is (currently)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   648
	     a bit slow :-(
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   649
	     We need the hasSubclasses-info bit in Behavior; now
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   650
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   651
    self withAllSubclassesDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   652
	ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   653
	ObjectMemory flushMethodCacheFor:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   654
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   655
"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   656
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   657
    nargs := newSelector numArgs.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   658
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   659
    ObjectMemory flushMethodCacheForSelector:newSelector.
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   660
"/    ObjectMemory flushMethodCache.
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   661
    ObjectMemory flushInlineCachesWithArgs:nargs.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   662
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   663
    ^ true
734
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   664
a4378f483a86 pass original method as changeArg when doing method changes;
Claus Gittinger <cg@exept.de>
parents: 662
diff changeset
   665
    "Created: 11.12.1995 / 13:59:37 / cg"
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   666
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   667
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   668
addSuperclass:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   669
    "EXPERIMENTAL MI support: add aClass to the set of classes, from which instances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   670
     inherit protocol."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   671
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   672
    "first, check if the class is abstract - 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   673
     allows abstract mixins are allowed in the current implementation"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   674
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   675
    aClass instSize == 0 ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   676
	self error:'only abstract mixins allowed'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   677
	^ self
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   678
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   679
    otherSuperclasses isNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   680
	otherSuperclasses := Array with:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   681
    ] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   682
	otherSuperclasses := otherSuperclasses copyWith:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   683
    ].
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   684
    SubclassInfo := nil.
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   685
    ObjectMemory flushCaches
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   686
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   687
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   688
category
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   689
    "return the category of the class. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   690
     Returning nil here, since Behavior does not define a category
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   691
     (only ClassDescriptions do)."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   692
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   693
    ^ nil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   694
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   695
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   696
     Point category                
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   697
     Behavior new category           
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   698
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   699
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   700
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   701
displayString
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   702
    "although behaviors have no name, we return something
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   703
     useful here - there are many places (inspectors) where
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   704
     a classes name is asked for.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   705
     Implementing this message here allows instances of anonymous classes
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   706
     to show a reasonable name."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   707
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   708
    ^ 'someBehavior'
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   709
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   710
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   711
flags
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   712
    "return the receivers flag bits"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   713
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   714
    ^ flags
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   715
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   716
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   717
implicit_methodDict 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   718
    "ST-80 compatibility.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   719
     This allows subclasses to assume there is an instance variable
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   720
     named methodDict."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   721
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   722
    ^ self methodDictionary
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   723
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   724
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   725
implicit_methodDict:aDictionary 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   726
    "ST-80 compatibility.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   727
     This allows subclasses to assume there is an instance variable
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   728
     named methodDict."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   729
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   730
    ^ self error:'not allowed to set the methodDictionary'
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   731
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   732
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   733
instSize
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   734
    "return the number of instance variables of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   735
     This includes all superclass instance variables."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   736
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   737
    ^ instSize
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   738
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   739
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   740
methodArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   741
    "return the receivers method array.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   742
     Notice: this is not compatible with ST-80."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   743
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   744
    ^ methodArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   745
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   746
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   747
methodDictionary
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   748
    "return the receivers method dictionary. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   749
     Since no dictionary is actually present, create one for ST-80 compatibility."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   750
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   751
    |dict n "{ Class: SmallInteger }"|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   752
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   753
    dict := IdentityDictionary new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   754
    n := selectorArray size.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   755
    1 to:n do:[:index |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   756
	dict at:(selectorArray at:index) put:(methodArray at:index)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   757
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   758
    ^ dict
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   759
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   760
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   761
name
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   762
    "although behaviors have no name, we return something
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   763
     useful here - there are many places (inspectors) where
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   764
     a classes name is asked for.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   765
     Implementing this message here allows anonymous classes
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   766
     and instances of them to be inspected."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   767
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   768
    ^ 'someBehavior'
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   769
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   770
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   771
removeSelector:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   772
    "remove the selector, aSelector and its associated method 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   773
     from the methodDictionary"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   774
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   775
    |index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   776
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   777
    index := selectorArray identityIndexOf:aSelector startingAt:1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   778
    (index == 0) ifTrue:[^ false].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   779
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   780
    newSelectorArray := selectorArray copyWithoutIndex:index.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   781
    newMethodArray := methodArray copyWithoutIndex:index.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   782
    oldSelectorArray := selectorArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   783
    oldMethodArray := methodArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   784
    selectorArray := newSelectorArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   785
    methodArray := newMethodArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   786
"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   787
    [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   788
	|nargs|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   789
	nargs := aSelector numArgs.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   790
	ObjectMemory flushMethodCache.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   791
	ObjectMemory flushInlineCachesWithArgs:nargs.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   792
    ] value
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   793
"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   794
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   795
     actually, we would do better with less flushing ...
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   796
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   797
    ObjectMemory flushCaches.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   798
    ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   799
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   800
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   801
removeSuperclass:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   802
    "EXPERIMENTAL MI support: remove aClass from the set of classes, from which instances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   803
     inherit protocol."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   804
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   805
    otherSuperclasses notNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   806
	otherSuperclasses := otherSuperclasses copyWithout:aClass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   807
	otherSuperclasses isEmpty ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   808
	    otherSuperclasses := nil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   809
	].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   810
	SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   811
	ObjectMemory flushCaches
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   812
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   813
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   814
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   815
selectorArray 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   816
    "return the receivers selector array.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   817
     Notice: this is not compatible with ST-80."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   818
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   819
    ^ selectorArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   820
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   821
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   822
selectors
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   823
    "return the receivers selector array as an orderedCollection.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   824
     Notice: this may not be compatible with ST-80.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   825
     (should we return a Set ?)"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   826
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   827
    ^ selectorArray asOrderedCollection
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   828
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   829
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   830
selectors:newSelectors methods:newMethods
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   831
    "set both selector array and method array of the receiver,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   832
     and flush caches"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   833
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   834
    ObjectMemory flushCaches.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   835
    selectorArray := newSelectors.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   836
    methodArray := newMethods
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   837
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   838
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   839
superclass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   840
    "return the receivers superclass"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   841
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   842
    ^ superclass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   843
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   844
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   845
superclass:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   846
    "set the superclass - this actually creates a new class,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   847
     recompiling all methods for the new one. The receiving class stays
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   848
     around anonymous to allow existing instances some life.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   849
     This may change in the future (adjusting existing instances)"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   850
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   851
    SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   852
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   853
    "must flush caches since lookup chain changes"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   854
    ObjectMemory flushCaches.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   855
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   856
"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   857
    superclass := aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   858
"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   859
    "for correct recompilation, just create a new class ..."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   860
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   861
    aClass subclass:(self name)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   862
	   instanceVariableNames:(self instanceVariableString)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   863
	   classVariableNames:(self classVariableString)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   864
	   poolDictionaries:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   865
	   category:self category
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   866
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   867
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   868
!Behavior methodsFor:'autoload check'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   869
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   870
autoload
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   871
    "force autoloading - do nothing here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   872
     redefined in Autoload; see comment there"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   873
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   874
    ^ self
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   875
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   876
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   877
isLoaded
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   878
    "return true, if the class has been loaded; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   879
     redefined in Autoload; see comment there"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   880
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   881
    ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   882
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   883
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   884
!Behavior methodsFor:'binary storage'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   885
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   886
binaryDefinitionFrom:stream manager:manager
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   887
    "sent during a binary read by the input manager.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   888
     Read the definition on an empty instance (of my class) from stream.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   889
     All pointer instances are left nil, while all bits are read in here.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   890
     return the new object."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   891
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   892
    |obj t
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   893
     basicSize "{ Class: SmallInteger }" |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   894
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   895
    self isPointers ifTrue: [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   896
	"/
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   897
	"/ inst size not needed - if you uncomment the line below,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   898
	"/ also uncomment the corresponding line in
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   899
	"/ Object>>storeBinaryDefinitionOn:manager:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   900
	"/
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   901
	"/ stream next. "skip instSize"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   902
	self isVariable ifTrue: [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   903
	    ^ self basicNew:(stream nextNumber:3)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   904
	].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   905
	^ self basicNew
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   906
    ].
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   907
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
   908
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   909
     an object with bit-valued instance variables.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   910
     These are read here.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   911
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   912
    basicSize := stream nextNumber:4.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   913
    obj := self basicNew:basicSize.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   914
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   915
    self isBytes ifTrue: [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   916
	stream nextBytes:basicSize into:obj
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   917
    ] ifFalse: [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   918
	self isWords ifTrue: [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   919
	    1 to:basicSize do:[:i |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   920
		obj basicAt:i put:(stream nextNumber:2)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   921
	    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   922
	] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   923
	    self isLongs ifTrue: [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   924
		1 to:basicSize do:[:i |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   925
		    obj basicAt:i put:(stream nextNumber:4)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   926
		]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   927
	    ] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   928
		self isFloats ifTrue: [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   929
		    "could do it in one big read on machines which use IEEE floats ..."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   930
		    t := Float basicNew.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   931
		    1 to:basicSize do:[:i |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   932
			Float readBinaryIEEESingleFrom:stream into:t.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   933
			obj basicAt:i put: t
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   934
		    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   935
		] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   936
		    self isDoubles ifTrue: [
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   937
			"could do it in one big read on machines which use IEEE doubles ..."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   938
			t := Float basicNew.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   939
			1 to:basicSize do:[:i |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   940
			    Float readBinaryIEEEDoubleFrom:stream into:t.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   941
			    obj basicAt:i put: t
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   942
			]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   943
		    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   944
		]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   945
	    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   946
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   947
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   948
    ^obj
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   949
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   950
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   951
canCloneFrom:anObject 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   952
    "return true, if this class can clone an obsolete object as retrieved
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   953
     by a binary load. Subclasses which do not want to have obsolete objects
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   954
     be converted, should redefine this method to return false.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   955
     (However, conversion is never done silently in a binary load; you
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   956
      have to have a handler for the binaryload errors and for the conversion
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   957
      request signal.)"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   958
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   959
    ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   960
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   961
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   962
cloneFrom:aPrototype
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   963
    "return an instance of myself with variables initialized from
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   964
     a prototype. This is used when instances of obsolete classes are
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   965
     binary loaded and a conversion is done on the obsolete object. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   966
     UserClasses may redefine this for better conversions."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   967
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   968
    |newInst indexed myInfo otherInfo varIndexAssoc|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   969
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   970
    indexed := false.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   971
    aPrototype class isVariable ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   972
	self isVariable ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   973
	    indexed := true.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   974
	].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   975
	"otherwise, these are lost ..."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   976
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   977
    indexed ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   978
	newInst := self basicNew:aPrototype basicSize
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   979
    ] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   980
	newInst := self basicNew
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   981
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   982
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   983
    myInfo := self instanceVariableOffsets.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   984
    otherInfo := aPrototype class instanceVariableOffsets.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   985
    myInfo keysAndValuesDo:[:name :index |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   986
	varIndexAssoc := otherInfo at:name ifAbsent:[].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   987
	varIndexAssoc notNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   988
	    newInst instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   989
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   990
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   991
    indexed ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   992
	1 to:aPrototype basicSize do:[:index |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   993
	    newInst basicAt:index put:(aPrototype basicAt:index)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   994
	].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   995
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   996
    ^ newInst
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   997
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   998
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   999
     Class withoutUpdatingChangesDo:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1000
	 Point subclass:#Point3D
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1001
	   instanceVariableNames:'z'
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1002
	   classVariableNames:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1003
	   poolDictionaries:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1004
	   category:'testing'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1005
	 (Point3D cloneFrom:1@2) inspect.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1006
     ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1007
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1008
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1009
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1010
     Class withoutUpdatingChangesDo:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1011
	 Point variableSubclass:#Point3D
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1012
	   instanceVariableNames:'z'
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1013
	   classVariableNames:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1014
	   poolDictionaries:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1015
	   category:'testing'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1016
	 (Point3D cloneFrom:#(1 2 3)) inspect.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1017
     ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1018
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1019
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1020
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1021
     |someObject|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1022
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1023
     Class withoutUpdatingChangesDo:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1024
	 Object subclass:#TestClass1 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1025
	   instanceVariableNames:'foo bar'
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1026
	   classVariableNames:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1027
	   poolDictionaries:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1028
	   category:'testing'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1029
	 someObject := TestClass1 new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1030
	 someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1031
	 Object subclass:#TestClass2 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1032
	   instanceVariableNames:'bar foo'
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1033
	   classVariableNames:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1034
	   poolDictionaries:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1035
	   category:'testing'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1036
	 (TestClass2 cloneFrom:someObject) inspect.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1037
     ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1038
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1039
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1040
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1041
readBinaryFrom:aStream
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1042
    "read an objects binary representation from the argument,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1043
     aStream and return it. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1044
     The read object must be a kind of myself, otherwise an error is raised. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1045
     To get any object, use 'Object readBinaryFrom:...',
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1046
     To get any number, use 'Number readBinaryFrom:...' and so on.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1047
     This is the reverse operation to 'storeBinaryOn:'. "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1048
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1049
    ^ self readBinaryFrom:aStream onError:[self error:('expected ' , self name)]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1050
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1051
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1052
     |s|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1053
     s := WriteStream on:(ByteArray new).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1054
     #(1 2 3 4) storeBinaryOn:s.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1055
     Object readBinaryFrom:(ReadStream on:s contents)  
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1056
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1057
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1058
     |s|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1059
     s := 'testFile' asFilename writeStream binary.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1060
     #(1 2 3 4) storeBinaryOn:s.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1061
     'hello world' storeBinaryOn:s.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1062
     s close.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1063
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1064
     s := 'testFile' asFilename readStream binary.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1065
     Transcript showCr:(Object readBinaryFrom:s).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1066
     Transcript showCr:(Object readBinaryFrom:s).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1067
     s close.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1068
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1069
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1070
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1071
readBinaryFrom:aStream onError:exceptionBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1072
    "read an objects binary representation from the argument,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1073
     aStream and return it. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1074
     The read object must be a kind of myself, otherwise the value of
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1075
     the exceptionBlock is returned.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1076
     To get any object, use 'Object readBinaryFrom:...',
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1077
     To get any number, use 'Number readBinaryFrom:...' and so on.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1078
     This is the reverse operation to 'storeBinaryOn:'. "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1079
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1080
    |newObject|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1081
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1082
    newObject := (BinaryInputManager new:1024) readFrom:aStream.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1083
    (newObject isKindOf:self) ifFalse:[^ exceptionBlock value].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1084
    ^ newObject
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1085
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1086
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1087
     |s|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1088
     s := WriteStream on:(ByteArray new).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1089
     #(1 2 3 4) storeBinaryOn:s.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1090
     Object readBinaryFrom:(ReadStream on:s contents) onError:['oops'] 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1091
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1092
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1093
     |s|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1094
     s := WriteStream on:(ByteArray new).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1095
     #[1 2 3 4] storeBinaryOn:s.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1096
     Array readBinaryFrom:(ReadStream on:s contents)  onError:['oops']  
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1097
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1098
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1099
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1100
storeBinaryDefinitionOn: stream manager: manager
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1101
    "binary store of a classes definition.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1102
     Classes will store the name only and restore by looking for
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1103
     that name in the Smalltalk dictionary."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1104
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1105
    | myName |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1106
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1107
    myName := self name.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1108
    stream nextNumber:4 put:self signature.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1109
    stream nextNumber:2 put:0.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1110
    stream nextNumber:2 put:myName size.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1111
    myName do:[:c| 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1112
	stream nextPut:c asciiValue
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1113
    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1114
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1115
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1116
     |s|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1117
     s := WriteStream on:ByteArray new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1118
     #(1 2 3 4) storeBinaryOn:s.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1119
     Object readBinaryFrom:(ReadStream on:s contents)  
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1120
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1121
     |s|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1122
     s := WriteStream on:ByteArray new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1123
     Rectangle storeBinaryOn:s.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1124
     Object readBinaryFrom:(ReadStream on:s contents)  
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1125
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1126
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1127
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1128
!Behavior methodsFor:'compiler interface'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1129
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1130
compiler
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1131
    "return the compiler to use for this class.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1132
     OBSOLETE: This is the old ST/X interface, kept for migration. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1133
	       Dont use it - it will vanish."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1134
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1135
    ^ self compilerClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1136
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1137
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1138
compilerClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1139
    "return the compiler to use for this class - 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1140
     this can be redefined in special classes, to get classes with
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1141
     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1142
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1143
    ^ Compiler
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1144
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1145
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1146
evaluatorClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1147
    "return the compiler to use for expression evaluation for this class - 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1148
     this can be redefined in special classes, to get classes with
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1149
     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1150
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1151
    ^ Compiler
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1152
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1153
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1154
!Behavior methodsFor:'copying'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1155
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1156
deepCopy
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1157
    "return a deep copy of the receiver
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1158
     - return the receiver here - time will show if this is ok"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1159
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1160
    ^ self
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1161
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1162
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1163
deepCopyUsing:aDictionary
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1164
    "return a deep copy of the receiver
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1165
     - return the receiver here - time will show if this is ok"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1166
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1167
    ^ self
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1168
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1169
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1170
simpleDeepCopy
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1171
    "return a deep copy of the receiver
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1172
     - return the receiver here - time will show if this is ok"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1173
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1174
    ^ self
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1175
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1176
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1177
!Behavior methodsFor:'enumerating'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1178
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1179
allDerivedInstancesDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1180
    "evaluate aBlock for all of my instances and all instances of subclasses.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1181
     This method is going to be removed for protocol compatibility with
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1182
     other STs; use allSubInstancesDo:"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1183
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1184
    self obsoleteMethodWarning:'please use #allSubInstancesDo:'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1185
    self allSubInstancesDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1186
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1187
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1188
     StandardSystemView allDerivedInstancesDo:[:v | Transcript showCr:(v name)]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1189
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1190
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1191
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1192
allInstancesDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1193
    "evaluate aBlock for all of my instances"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1194
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1195
"/    ObjectMemory allObjectsDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1196
"/        (anObject class == self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1197
"/            aBlock value:anObject
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1198
"/        ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1199
"/    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1200
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1201
    ObjectMemory allInstancesOf:self do:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1202
	aBlock value:anObject
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1203
    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1204
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1205
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1206
     StandardSystemView allInstancesDo:[:v | Transcript showCr:(v name)]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1207
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1208
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1209
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1210
allSubInstancesDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1211
    "evaluate aBlock for all of my instances and all instances of subclasses"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1212
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1213
    ObjectMemory allObjectsDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1214
	(anObject isKindOf:self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1215
	    aBlock value:anObject
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1216
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1217
    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1218
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1219
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1220
     StandardSystemView allSubInstancesDo:[:v | Transcript showCr:(v name)]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1221
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1222
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1223
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1224
allSubclassesDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1225
    "evaluate aBlock for all of my subclasses.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1226
     There is no specific order, in which the entries are enumerated.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1227
     This will only enumerate globally known classes - for anonymous
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1228
     behaviors, you have to walk over all instances of Behavior."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1229
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1230
    Smalltalk allBehaviorsDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1231
	(aClass isSubclassOf:self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1232
	    aBlock value:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1233
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1234
    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1235
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1236
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1237
     Collection allSubclassesDo:[:c | Transcript showCr:(c name)]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1238
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1239
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1240
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1241
allSubclassesInOrderDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1242
    "evaluate aBlock for all of my subclasses.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1243
     Higher level subclasses will be enumerated before the deeper ones,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1244
     so the order in which aBlock gets called is ok to fileOut classes in
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1245
     correct order for later fileIn.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1246
     This will only enumerate globally known classes - for anonymous
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1247
     behaviors, you have to walk over all instances of Behavior"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1248
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1249
    self subclassesDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1250
	aBlock value:aClass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1251
	aClass allSubclassesInOrderDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1252
    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1253
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1254
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1255
     Collection allSubclassesInOrderDo:[:c | Transcript showCr:(c name)]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1256
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1257
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1258
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1259
allSuperclassesDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1260
    "evaluate aBlock for all of my superclasses"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1261
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1262
    |theClass|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1263
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1264
    theClass := superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1265
    [theClass notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1266
	aBlock value:theClass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1267
	theClass := theClass superclass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1268
    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1269
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1270
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1271
     String allSuperclassesDo:[:c | Transcript showCr:(c name)]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1272
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1273
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1274
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1275
subclassesDo:aBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1276
    "evaluate the argument, aBlock for all immediate subclasses.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1277
     This will only enumerate globally known classes - for anonymous
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1278
     behaviors, you have to walk over all instances of Behavior."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1279
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1280
    |coll|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1281
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1282
    SubclassInfo isNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1283
	Behavior subclassInfo
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1284
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1285
    SubclassInfo notNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1286
	coll := SubclassInfo at:self ifAbsent:nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1287
	coll notNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1288
	    coll do:aBlock.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1289
	].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1290
	^ self
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1291
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1292
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1293
    Smalltalk allBehaviorsDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1294
	(aClass superclass == self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1295
	    aBlock value:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1296
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1297
    ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1298
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1299
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1300
     Collection subclassesDo:[:c | Transcript showCr:(c name)]
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  1301
    "
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  1302
! !
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  1303
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1304
!Behavior methodsFor:'initialization'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1305
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1306
deinitialize
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1307
    "deinitialize is sent to a class before it is physically unloaded.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1308
     This is only done with classes which have been loaded in from a binary
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1309
     file. Classes may release any primitive memory or other stuff which is
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1310
     not visible to smalltalk (for example, release internal memory).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1311
     The default action here is to do nothing."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1312
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1313
    ^ self
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1314
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1315
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1316
initialize
442
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1317
    "initialize is sent to a class either during startup,
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1318
     (for all statically compiled-in classes) or after a class
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1319
     has been loaded into the system (either bytecodes or machinecode).
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1320
     The default action here is to do nothing."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1321
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1322
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1323
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1324
328
claus
parents: 325
diff changeset
  1325
postAutoload
442
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1326
    "postAutoload is sent to a class after it has been autoloaded.
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1327
     This gives it a chance to arrange for automatic unloading to be done
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1328
     after a while ...
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1329
     This is NOT sent to statically compiled in or explicitely filedIn
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1330
     classes.
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1331
     The default action here is to do nothing."
328
claus
parents: 325
diff changeset
  1332
claus
parents: 325
diff changeset
  1333
    ^ self
claus
parents: 325
diff changeset
  1334
!
claus
parents: 325
diff changeset
  1335
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1336
reinitialize
442
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1337
    "reinitialize is sent to a class when an image has been restarted.
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1338
     I.e. when the system is restarted.
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1339
     This gives classes a chance to flush any device dependent or otherwise
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1340
     obsolete data which may be a leftover from the previous live.
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1341
     The default action here is to do nothing."
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1342
65a11cda5e9e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
  1343
    ^ self
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1344
! !
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1345
492
fa23b14f444b renamed instance creation category
Claus Gittinger <cg@exept.de>
parents: 457
diff changeset
  1346
!Behavior methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1347
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1348
basicNew
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1349
    "return an instance of myself without indexed variables.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1350
     If the receiver-class has indexed instvars, the new object will have
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1351
     a basicSize of zero - 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1352
     i.e. 'aClass basicNew' is equivalent to 'aClass basicNew:0'.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1353
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1354
     ** Do not redefine this method in any class **"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1355
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1356
%{  /* NOCONTEXT */
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1357
    REGISTER OBJ newobj;
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1358
    REGISTER char *nextPtr;
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1359
    unsigned int instsize;
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1360
    REGISTER unsigned int nInstVars;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1361
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1362
    /*
369
claus
parents: 362
diff changeset
  1363
     * the following ugly code is nothing more than a __new() followed
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1364
     * by a nilling of the new instance.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1365
     * Unrolled for a bit more speed since this is one of the central object 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1366
     * allocation methods in the system
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1367
     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1368
    nInstVars = __intVal(__INST(instSize));
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1369
    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1370
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1371
    newobj = (OBJ) __newNextPtr;
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1372
    nextPtr = ((char *)newobj) + instsize;
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1373
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1374
    /*
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1375
     * dont argue about the goto and the arrangement below - it saves 
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1376
     * an extra nil-compare and branch in the common case ...
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1377
     * (i.e. if no GC is needed, we fall through without a branch)
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1378
     */
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1379
    if (nextPtr < __newEndPtr) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1380
	_objPtr(newobj)->o_size = instsize;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1381
	/* o_allFlags(newobj) = 0;              */
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1382
	/* _objPtr(newobj)->o_space = __newSpace; */
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1383
	o_setAllFlags(newobj, __newSpace);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1384
#ifdef ALIGN4
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1385
	__newNextPtr = nextPtr;
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1386
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1387
	if (instsize & (ALIGN-1)) {
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1388
	    __newNextPtr = (char *)newobj + (instsize & ~(ALIGN-1)) + ALIGN;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1389
	} else {
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1390
	    __newNextPtr = nextPtr;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1391
	}
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1392
#endif
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1393
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1394
ok:
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1395
	__InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1396
	__qSTORE(newobj, self);
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1397
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1398
	if (nInstVars) {
788
e80f1c42b87b dont use memset4 if its undefined
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
  1399
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1400
	    memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1401
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1402
	    REGISTER OBJ *op;
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1403
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1404
	    op = __InstPtr(newobj)->i_instvars;
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1405
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1406
# if !defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1407
	    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1408
	     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1409
	     */
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1410
#  if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1411
	    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1412
		*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1413
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1414
		while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1415
		    *(double *)op = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1416
		    ((double *)op)[1] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1417
		    ((double *)op)[2] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1418
		    ((double *)op)[3] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1419
		    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1420
		    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1421
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1422
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1423
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1424
		*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1425
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1426
	    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1427
#  else
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1428
#   if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1429
	    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1430
		*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1431
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1432
		while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1433
		    *(long long *)op = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1434
		    ((long long *)op)[1] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1435
		    ((long long *)op)[2] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1436
		    ((long long *)op)[3] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1437
		    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1438
		    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1439
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1440
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1441
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1442
		*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1443
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1444
	    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1445
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1446
#   else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1447
#    if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1448
	    while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1449
		*op = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1450
		*(op+1) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1451
		*(op+2) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1452
		*(op+3) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1453
		*(op+4) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1454
		*(op+5) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1455
		*(op+6) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1456
		*(op+7) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1457
		op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1458
		nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1459
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1460
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1461
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1462
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1463
	    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1464
#    else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1465
#     if defined(FAST_MEMSET)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1466
	    memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1467
#     else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1468
	    do {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1469
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1470
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1471
	    } while (nInstVars != 0);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1472
#     endif
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1473
#    endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1474
#   endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1475
#  endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1476
# else /* nil could be ~~ 0 */
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1477
	    while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1478
		*op = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1479
		*(op+1) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1480
		*(op+2) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1481
		*(op+3) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1482
		*(op+4) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1483
		*(op+5) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1484
		*(op+6) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1485
		*(op+7) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1486
		op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1487
		nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1488
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1489
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1490
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1491
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1492
	    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1493
# endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1494
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1495
	}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1496
	RETURN ( newobj );
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1497
    }
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1498
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1499
    /*
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1500
     * the slow case - a GC will occur
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1501
     */
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1502
    __PROTECT_CONTEXT__
369
claus
parents: 362
diff changeset
  1503
    newobj = __new(instsize);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1504
    __UNPROTECT_CONTEXT__
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1505
    if (newobj != nil) goto ok;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1506
%}
2
claus
parents: 1
diff changeset
  1507
.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1508
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1509
     memory allocation failed.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1510
     When we arrive here, there was no memory, even after
165
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1511
     a garbage collect. 
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1512
     This means, that the VM wanted to get some more memory from the 
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1513
     Operatingsystem, which was not kind enough to give it.
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1514
     Bad luck - you should increase the swap space on your machine.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1515
    "
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1516
    ^ ObjectMemory allocationFailureSignal raise.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1517
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1518
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1519
basicNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1520
    "return an instance of myself with anInteger indexed variables.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1521
     If the receiver-class has no indexed instvars, this is only allowed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1522
     if the argument, anInteger is zero.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1523
     ** Do not redefine this method in any class **"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1524
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1525
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1526
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1527
    OBJ newobj;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1528
    unsigned INT instsize, nInstVars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1529
    INT nindexedinstvars;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1530
    unsigned INT flags;
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1531
#if ! defined(FAST_ARRAY_MEMSET) || defined(NEGATIVE_ADDRESSES)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1532
    REGISTER char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1533
    short *sp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1534
    long *lp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1535
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1536
    REGISTER OBJ *op;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1537
    float *fp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1538
    double *dp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1539
249
claus
parents: 216
diff changeset
  1540
    if (__isSmallInteger(anInteger)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1541
	nindexedinstvars = __intVal(anInteger);
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1542
	if (nindexedinstvars >= 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1543
	    nInstVars = __intVal(__INST(instSize));
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1544
	    flags = __intVal(__INST(flags)) & ARRAYMASK;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1545
	    switch (flags) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1546
		case BYTEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1547
		    instsize = OHDR_SIZE + nindexedinstvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1548
		    if (nInstVars == 0) {
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1549
			if (__CanDoQuickNew(instsize)) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1550
			    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1551
			     * the most common case
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1552
			     */
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1553
			    __qCheckedNew(newobj, instsize);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1554
			    __InstPtr(newobj)->o_class = self;
788
e80f1c42b87b dont use memset4 if its undefined
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
  1555
#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
359
claus
parents: 357
diff changeset
  1556
			    nInstVars = nindexedinstvars >> 2;
claus
parents: 357
diff changeset
  1557
			    if (nindexedinstvars & 3) nInstVars++;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1558
			    memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars);
357
claus
parents: 356
diff changeset
  1559
#else
claus
parents: 356
diff changeset
  1560
# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1561
			    memset(__InstPtr(newobj)->i_instvars, 0, nindexedinstvars);
357
claus
parents: 356
diff changeset
  1562
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1563
			    cp = (char *)__InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1564
			    while (nindexedinstvars >= sizeof(long)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1565
				*(long *)cp = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1566
				cp += sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1567
				nindexedinstvars -= sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1568
			    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1569
			    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1570
				*cp++ = '\0';
357
claus
parents: 356
diff changeset
  1571
# endif
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1572
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1573
			    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1574
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1575
		    } else {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1576
			instsize += __OBJS2BYTES__(nInstVars);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1577
		    }
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1578
		    __PROTECT_CONTEXT__
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1579
		    __qNew(newobj, instsize, SENDER);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1580
		    __UNPROTECT_CONTEXT__
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1581
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1582
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1583
		    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1584
		    __InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1585
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1586
788
e80f1c42b87b dont use memset4 if its undefined
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
  1587
#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
357
claus
parents: 356
diff changeset
  1588
		    nInstVars = (instsize-OHDR_SIZE) >> 2;
claus
parents: 356
diff changeset
  1589
		    if (instsize & 3) nInstVars++;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1590
		    memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars);
357
claus
parents: 356
diff changeset
  1591
#else
claus
parents: 356
diff changeset
  1592
# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1593
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1594
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1595
		     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1596
		    memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
357
claus
parents: 356
diff changeset
  1597
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1598
		    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1599
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1600
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1601
		    cp = (char *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1602
		    while (nindexedinstvars >= sizeof(long)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1603
			*(long *)cp = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1604
			cp += sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1605
			nindexedinstvars -= sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1606
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1607
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1608
			*cp++ = '\0';
357
claus
parents: 356
diff changeset
  1609
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1610
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1611
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1612
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1613
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1614
		case WORDARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1615
		    instsize = OHDR_SIZE + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1616
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1617
			       nindexedinstvars * sizeof(short);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1618
		    __PROTECT_CONTEXT__
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1619
		    __qNew(newobj, instsize, SENDER);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1620
		    __UNPROTECT_CONTEXT__
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1621
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1622
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1623
		    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1624
		    __InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1625
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1626
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1627
#if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1628
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1629
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1630
		     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1631
		    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1632
#else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1633
		    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1634
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1635
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1636
		    sp = (short *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1637
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1638
			*sp++ = 0;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1639
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1640
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1641
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1642
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1643
	       case LONGARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1644
		    instsize = OHDR_SIZE + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1645
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1646
			       nindexedinstvars * sizeof(long);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1647
		    __PROTECT_CONTEXT__
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1648
		    __qAlignedNew(newobj, instsize, SENDER);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1649
		    __UNPROTECT_CONTEXT__
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1650
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1651
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1652
		    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1653
		    __InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1654
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1655
788
e80f1c42b87b dont use memset4 if its undefined
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
  1656
#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1657
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1658
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1659
		     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1660
		    memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars + nindexedinstvars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1661
#else
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1662
# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1663
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1664
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1665
		     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1666
		    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1667
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1668
		    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1669
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1670
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1671
		    lp = (long *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1672
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1673
			*lp++ = 0;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1674
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1675
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1676
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1677
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1678
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1679
	       case FLOATARRAY:
325
claus
parents: 323
diff changeset
  1680
		    instsize = sizeof(struct __floatArray) + 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1681
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1682
			       (nindexedinstvars - 1) * sizeof(float);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1683
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1684
		    __PROTECT_CONTEXT__
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1685
		    __qNew(newobj, instsize, SENDER);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1686
		    __UNPROTECT_CONTEXT__
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1687
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1688
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1689
		    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1690
		    __InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1691
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1692
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1693
		    op = __InstPtr(newobj)->i_instvars;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1694
# if defined(mips) /* knowin that float 0.0 is all-zeros */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1695
		    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1696
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1697
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1698
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1699
		    fp = (float *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1700
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1701
			*fp++ = 0.0;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1702
# endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1703
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1704
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1705
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1706
	       case DOUBLEARRAY:
325
claus
parents: 323
diff changeset
  1707
		    instsize = sizeof(struct __doubleArray) + 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1708
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1709
			       (nindexedinstvars - 1) * sizeof(double);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1710
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1711
		    __PROTECT_CONTEXT__
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1712
		    __qAlignedNew(newobj, instsize, SENDER);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1713
		    __UNPROTECT_CONTEXT__
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1714
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1715
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1716
		    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1717
		    __InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1718
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1719
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1720
		    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1721
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1722
			*op++ = nil;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1723
#ifdef NEED_DOUBLE_ALIGN
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1724
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1725
		     * care for double alignment
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1726
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1727
		    if ((INT)op & (ALIGN-1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1728
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1729
		    }
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1730
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1731
		    dp = (double *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1732
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1733
			*dp++ = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1734
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1735
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1736
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1737
		case WKPOINTERARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1738
		case POINTERARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1739
		    nInstVars += nindexedinstvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1740
		    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1741
		    __PROTECT_CONTEXT__
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1742
		    __qAlignedNew(newobj, instsize, SENDER);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1743
		    __UNPROTECT_CONTEXT__
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1744
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1745
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1746
		    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1747
		    __InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1748
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1749
788
e80f1c42b87b dont use memset4 if its undefined
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
  1750
#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1751
		    memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1752
#else
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1753
# if !defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1754
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1755
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1756
		     */
360
claus
parents: 359
diff changeset
  1757
#ifdef XXmips
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1758
# undef FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1759
# undef FAST_ARRAY_MEMSET_LONGLONG_UNROLLED
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1760
/* seems to be slightly faster */
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1761
# define FAST_ARRAY_MEMSET
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1762
#endif
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1763
#ifdef sparc
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1764
# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1765
#endif
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1766
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1767
#  if defined(FAST_ARRAY_MEMSET_DOUBLES_UNROLLED)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1768
		    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1769
		    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1770
			*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1771
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1772
			while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1773
			    *(double *)op = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1774
			    ((double *)op)[1] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1775
			    ((double *)op)[2] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1776
			    ((double *)op)[3] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1777
			    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1778
			    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1779
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1780
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1781
		    while (nInstVars) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1782
			*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1783
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1784
		    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1785
#  else
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1786
#   if defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1787
		    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1788
		    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1789
			*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1790
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1791
			while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1792
			    *(long long *)op = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1793
			    ((long long *)op)[1] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1794
			    ((long long *)op)[2] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1795
			    ((long long *)op)[3] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1796
			    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1797
			    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1798
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1799
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1800
		    while (nInstVars) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1801
			*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1802
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1803
		    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1804
#   else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1805
#    if defined(FAST_ARRAY_MEMSET)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1806
		    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1807
#    else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1808
		    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1809
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1810
			*op++ = nil;
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1811
#    endif
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1812
#   endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1813
#  endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1814
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1815
		    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1816
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1817
			*op++ = nil;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1818
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1819
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1820
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1821
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1822
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1823
		default:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1824
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1825
		     * new:n for non-variable classes only allowed if
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1826
		     * n == 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1827
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1828
		    if (nindexedinstvars == 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1829
			instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1830
			__PROTECT_CONTEXT__
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
  1831
			__qAlignedNew(newobj, instsize, SENDER);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1832
			__UNPROTECT_CONTEXT__
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1833
			if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1834
			    break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1835
			}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1836
			__InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1837
			__qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1838
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1839
			if (nInstVars) {
788
e80f1c42b87b dont use memset4 if its undefined
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
  1840
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1841
			    memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1842
#else
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1843
# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1844
			    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1845
			     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1846
			     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1847
			    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1848
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  1849
			    op = __InstPtr(newobj)->i_instvars;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1850
			    do {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1851
				*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1852
			    } while (--nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1853
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1854
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1855
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1856
			RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1857
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1858
		    break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1859
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1860
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1861
    }
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1862
%}.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1863
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1864
     arrive here if something went wrong ...
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1865
     figure out what it was
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1866
    "
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1867
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1868
    (anInteger isMemberOf:SmallInteger) ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1869
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1870
	 the argument is either not an integer,
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1871
	 or a LargeInteger (which means that its definitely too big)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1872
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1873
	self error:'argument to new: must be Integer'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1874
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1875
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1876
    (anInteger < 0) ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1877
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1878
	 the argument is negative,
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1879
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1880
	self error:'bad (negative) argument to new:'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1881
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1882
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1883
    self isVariable ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1884
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1885
	 this class does not have any indexed instance variables
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1886
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1887
	self error:'class has no indexed instvars - cannot create with new:'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1888
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1889
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1890
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1891
     memory allocation failed.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1892
     When we arrive here, there was no memory, even after
165
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1893
     a garbage collect. 
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1894
     This means, that the VM wanted to get some more memory from the 
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1895
     Operatingsystem, which was not kind enough to give it.
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1896
     Bad luck - you should increase the swap space on your machine.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1897
    "
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1898
    ^ ObjectMemory allocationFailureSignal raise.
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1899
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1900
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1901
new
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1902
    "return an instance of myself without indexed variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1903
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1904
    ^ self basicNew
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1905
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1906
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1907
new:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1908
    "return an instance of myself with anInteger indexed variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1909
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1910
    ^ self basicNew:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1911
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1912
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1913
niceBasicNew:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1914
    "same as basicNew:anInteger, but tries to avoid long pauses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1915
     due to garbage collection. This method checks to see if
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1916
     allocation is possible without a pause, and does a background
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1917
     incremental garbage collect first if there is not enough memory
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1918
     available at the moment for fast allocation. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1919
     This is useful in low-priority background processes which like to 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1920
     avoid disturbing any higher priority foreground process while allocating
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1921
     big amounts of memory. Of course, using this method only makes
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1922
     sense for big or huge objects (say > 200k).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1923
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1924
     EXPERIMENTAL: this is a non-standard interface and should only 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1925
     be used for special applications. There is no guarantee, that this
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1926
     method will be available in future ST/X releases."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1927
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1928
    |size|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1929
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1930
    size := self sizeOfInst:anInteger.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1931
    (ObjectMemory checkForFastNew:size) ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1932
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1933
	 incrementally collect garbage
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1934
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1935
	ObjectMemory incrementalGC.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1936
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1937
    ^ self basicNew:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1938
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1939
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1940
readFrom:aStream
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  1941
    "read an objects printed representation from the argument, aStream 
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  1942
     and return it. 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1943
     The read object must be a kind of myself if its not, an error is raised.
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1944
     This is the reverse operation to 'storeOn:'.
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  1945
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1946
     WARNING: storeOn: does not handle circular references and multiple 
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1947
	      references to the same object.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1948
	      Use #storeBinary:/readBinaryFrom: for this."
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1949
345
claus
parents: 343
diff changeset
  1950
    ^ self readFrom:aStream onError:[self error:'expected: ' , self name]
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1951
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1952
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1953
     |s|
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1954
     s := WriteStream on:String new.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1955
     #(1 2 3 4) storeOn:s.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1956
     Object readFrom:(ReadStream on:s contents)  
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1957
    "
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1958
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1959
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1960
readFrom:aStream onError:exceptionBlock
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1961
    "read an objects printed representation from the argument, aStream 
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1962
     and return it (i.e. the stream should contain some representation of
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1963
     the object which was created using #storeOn:). 
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1964
     The read object must be a kind of myself if its not, the value of
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1965
     exceptionBlock is returned.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1966
     To get any object, use 'Object readFrom:...',
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1967
     To get any number, use 'Number readFrom:...' and so on.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1968
     This is the reverse operation to 'storeOn:'.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1969
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1970
     WARNING: storeOn: does not handle circular references and multiple 
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1971
	      references to the same object.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1972
	      Use #storeBinary:/readBinaryFrom: for this."
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1973
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1974
    |newObject|
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1975
340
claus
parents: 331
diff changeset
  1976
    ErrorSignal handle:[:ex |
claus
parents: 331
diff changeset
  1977
	ex return
claus
parents: 331
diff changeset
  1978
    ] do:[
345
claus
parents: 343
diff changeset
  1979
	newObject := self evaluatorClass evaluate:aStream.
340
claus
parents: 331
diff changeset
  1980
    ].
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1981
    (newObject isKindOf:self) ifFalse:[^ exceptionBlock value].
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1982
    ^ newObject
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1983
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1984
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1985
     |s|
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1986
     s := WriteStream on:String new.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1987
     #(1 2 3 4) storeOn:s.
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1988
     Transcript showCr:(
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1989
	Array readFrom:(ReadStream on:s contents) onError:'not an Array'
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1990
     )
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1991
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1992
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1993
     |s|
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1994
     s := WriteStream on:String new.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1995
     #[1 2 3 4] storeOn:s.
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1996
     Transcript showCr:(
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1997
	 Array readFrom:(ReadStream on:s contents) onError:'not an Array'
345
claus
parents: 343
diff changeset
  1998
     )
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1999
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2000
!
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2001
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2002
readFromString:aString
275
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2003
    "create an object from its printed representation.
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2004
     For most classes, the string is expected to be in a format created by
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2005
     storeOn: or storeString; however, some (Time, Date) expect a user
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2006
     readable string here.
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2007
     See comments in Behavior>>readFromString:onError:,
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2008
     Behavior>>readFrom: and Behavior>>readFrom:onError:"
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2009
345
claus
parents: 343
diff changeset
  2010
    ^ self readFromString:aString onError:[self error:'expected: ' , self name]
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2011
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2012
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2013
     Integer readFromString:'12345678901234567890' 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2014
     Point readFromString:'1@2'  
345
claus
parents: 343
diff changeset
  2015
     Point readFromString:'1'  
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2016
    "
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2017
!
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2018
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2019
readFromString:aString onError:exceptionBlock
275
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2020
    "create an object from its printed representation.
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2021
     Here, the string is expected to be in a format created by
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2022
     storeOn: or storeString; however, some classes (Time, Date) may redefine
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2023
     it to expect a user readable string here.
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2024
     See comments in Behavior>>readFrom: and Behavior>>readFrom:onError:"
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2025
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2026
    ^ self readFrom:(ReadStream on:aString) onError:exceptionBlock
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2027
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2028
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2029
     Integer readFromString:'12345678901234567890' 
275
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2030
     Integer readFromString:'abc' 
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2031
     Integer readFromString:'abc' onError:0
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2032
     Point readFromString:'1@2'  
345
claus
parents: 343
diff changeset
  2033
     Point readFromString:'0'   
275
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2034
     Point readFromString:'0' onError:[0@0]  
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2035
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2036
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2037
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2038
uninitializedNew
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2039
    "create an instance of myself with uninitialized contents.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2040
     For all classes except ByteArray, this is the same as #basicNew."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2041
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2042
    ^ self basicNew
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2043
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2044
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2045
uninitializedNew:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2046
    "create an instance of myself with uninitialized contents.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2047
     For all classes except ByteArray, this is the same as #basicNew:."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2048
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2049
    ^ self basicNew:anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2050
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2051
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2052
!Behavior methodsFor:'private accessing'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2053
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2054
flags:aNumber
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2055
    "set the flags.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2056
     this method is for special uses only - there will be no recompilation
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2057
     and no change record written here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2058
     Do NOT use it."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2059
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2060
    flags := aNumber
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2061
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2062
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2063
instSize:aNumber
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2064
    "set the instance size.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2065
     this method is for special uses only - there will be no recompilation
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2066
     and no change record written here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2067
     Do NOT use it."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2068
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2069
    instSize := aNumber
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2070
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2071
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2072
primAddSelector:newSelector withMethod:newMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2073
    "add the method given by 2nd argument under the selector given by
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2074
     the 1st argument to the methodDictionary. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2075
     Does NOT flush any caches, does NOT write a change record.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2076
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2077
     Do not use this in normal situations, strange behavior will be
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2078
     the consequence.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2079
     I.e. executing obsolete methods, since the old method will still 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2080
     be executed out of the caches."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2081
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2082
    |index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2083
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2084
    (newSelector isMemberOf:Symbol) ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2085
	self error:'invalid selector'. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2086
	^ false
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2087
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2088
    newMethod isNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2089
	self error:'invalid method'. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2090
	^ false
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2091
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2092
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2093
    index := selectorArray identityIndexOf:newSelector startingAt:1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2094
    (index == 0) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2095
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2096
	 a new selector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2097
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2098
	newSelectorArray := selectorArray copyWith:newSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2099
	newMethodArray := methodArray copyWith:newMethod.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2100
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2101
	 keep a reference so they wont go away ...
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2102
	 mhmh: this is no longer needed - try without
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2103
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2104
	oldSelectorArray := selectorArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2105
	oldMethodArray := methodArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2106
	selectorArray := newSelectorArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2107
	methodArray := newMethodArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2108
    ] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2109
	methodArray at:index put:newMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2110
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2111
    ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2112
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2113
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2114
setMethodArray:anArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2115
    "set the method array of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2116
     this method is for special uses only - there will be no recompilation
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2117
     and no change record written here.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2118
     NOT for general use."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2119
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2120
    methodArray := anArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2121
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2122
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2123
setMethodDictionary:aDictionary
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2124
    "set the receivers method dictionary. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2125
     Since no dictionary is actually used, decompose into selector- and
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2126
     method arrays and set those. For ST-80 compatibility.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2127
     NOT for general use."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2128
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2129
    |n newSelectorArray newMethodArray idx|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2130
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2131
    n := aDictionary size.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2132
    newSelectorArray := Array basicNew:n.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2133
    newMethodArray := Array basicNew:n.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2134
    idx := 1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2135
    aDictionary keysAndValuesDo:[:sel :method |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2136
	newSelectorArray at:idx put:sel.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2137
	newMethodArray at:idx put:method.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2138
	idx := idx + 1
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2139
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2140
    selectorArray := newSelectorArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2141
    methodArray := newMethodArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2142
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2143
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2144
setOtherSuperclasses:anArrayOfClasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2145
    "EXPERIMENTAL: set the other superclasses of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2146
     this method is for special uses only - there will be no recompilation
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2147
     and no change record written here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2148
     Do NOT use it."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2149
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2150
    SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2151
    otherSuperclasses := anArrayOfClasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2152
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2153
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2154
setSelectorArray:anArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2155
    "set the selector array of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2156
     this method is for special uses only - there will be no recompilation
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2157
     and no change record written here.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2158
     NOT for general use."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2159
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2160
    selectorArray := anArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2161
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2162
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2163
setSelectors:sels methods:m
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2164
    "set some inst vars. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2165
     this method is for special uses only - there will be no recompilation
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2166
     and no change record written here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2167
     Do NOT use it."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2168
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2169
    selectorArray := sels.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2170
    methodArray := m.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2171
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2172
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2173
setSuperclass:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2174
    "set the superclass of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2175
     this method is for special uses only - there will be no recompilation
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2176
     and no change record written here. Also, if the receiver class has
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2177
     already been in use, future operation of the system is not guaranteed to
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2178
     be correct, since no caches are flushed.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2179
     Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least)"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2180
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2181
    SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2182
    superclass := aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2183
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2184
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2185
setSuperclass:sup selectors:sels methods:m instSize:i flags:f
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2186
    "set some inst vars. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2187
     this method is for special uses only - there will be no recompilation
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2188
     and no change record is written here. Also, if the receiver class has 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2189
     already been in use, future operation of the system is not guaranteed to
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2190
     be correct, since no caches are flushed.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2191
     Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least)"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2192
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2193
    SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2194
    superclass := sup.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2195
    selectorArray := sels.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2196
    methodArray := m.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2197
    instSize := i.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2198
    flags := f
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2199
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2200
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2201
!Behavior methodsFor:'queries'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2202
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2203
allClassVarNames
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2204
    "return a collection of all the class variable name-strings
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2205
     this includes all superclass-class variables.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2206
     Since Behavior has no idea of classvar-names, return an empty collection
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2207
     here. Redefined in ClassDescription."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2208
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2209
    ^ #()
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2210
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2211
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2212
allDerivedInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2213
    "return a collection of all instances of myself and 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2214
     instances of all subclasses of myself.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2215
     This method is going to be removed for protocol compatibility with
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2216
     other STs; use allSubInstances"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2217
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2218
    self obsoleteMethodWarning:'please use #allSubInstances'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2219
    ^ self allSubInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2220
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2221
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2222
allInstVarNames
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2223
    "return a collection of all the instance variable name-strings
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2224
     this includes all superclass-instance variables.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2225
     Since Behavior has no idea of instvar-names, return an empty collection
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2226
     here. Redefined in ClassDescription."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2227
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2228
    ^ #()
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2229
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2230
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2231
allInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2232
    "return a collection of all my instances"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2233
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2234
    "Read the documentation on why there seem to be no
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2235
     instances of SmallInteger and UndefinedObject"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2236
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2237
    |coll|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2238
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2239
    coll := OrderedCollection new:100.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2240
    self allInstancesDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2241
	coll add:anObject
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2242
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2243
    ^ coll 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2244
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2245
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2246
     ScrollBar allInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2247
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2248
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2249
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2250
allSubInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2251
    "return a collection of all instances of myself and 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2252
     instances of all subclasses of myself."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2253
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2254
    |coll|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2255
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2256
    coll := OrderedCollection new:100.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2257
    self allSubInstancesDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2258
	(anObject isKindOf:self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2259
	    coll add:anObject
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2260
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2261
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2262
    ^ coll 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2263
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2264
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2265
     View allSubInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2266
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2267
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2268
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2269
allSubclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2270
    "return a collection of all subclasses (direct AND indirect) of
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2271
     the receiver. There will be no specific order, in which entries
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2272
     are returned."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2273
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2274
    |newColl|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2275
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2276
    newColl := OrderedCollection new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2277
    self allSubclassesDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2278
	newColl add:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2279
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2280
    ^ newColl
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2281
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2282
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2283
     Collection allSubclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2284
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2285
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2286
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2287
allSubclassesInOrder
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2288
    "return a collection of all subclasses (direct AND indirect) of
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2289
     the receiver. Higher level subclasses will come before lower ones."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2290
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2291
    |newColl|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2292
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2293
    newColl := OrderedCollection new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2294
    self allSubclassesInOrderDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2295
	newColl add:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2296
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2297
    ^ newColl
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2298
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2299
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2300
     Collection allSubclassesInOrder
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2301
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2302
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2303
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2304
allSuperclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2305
    "return a collection of the receivers accumulated superclasses"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2306
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2307
    |aCollection theSuperClass|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2308
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2309
    theSuperClass := superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2310
    theSuperClass notNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2311
	aCollection := OrderedCollection new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2312
	[theSuperClass notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2313
	    aCollection add:theSuperClass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2314
	    theSuperClass := theSuperClass superclass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2315
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2316
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2317
    ^ aCollection
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2318
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2319
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2320
     String allSuperclasses 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2321
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2322
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2323
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2324
cachedLookupMethodFor:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2325
    "return the method, which would be executed if aSelector was sent to
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2326
     an instance of the receiver. I.e. the selector arrays of the receiver
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2327
     and all of its superclasses are searched for aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2328
     Return the method, or nil if instances do not understand aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2329
     This interface provides exactly the same information as #lookupMethodFor:,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2330
     but uses the lookup-cache in the VM for faster search. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2331
     However, keep in mind, that doing a lookup through the cache also adds new
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2332
     entries and can thus slow down the system by polluting the cache with 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2333
     irrelevant entries. (do NOT loop over all objects calling this method).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2334
     Does NOT (currently) handle MI"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2335
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2336
%{  /* NOCONTEXT */
829
fc386319f41c removed external function defs (soon no longer allowed)
Claus Gittinger <cg@exept.de>
parents: 816
diff changeset
  2337
    RETURN ( __lookup(self, aSelector, SENDER) );
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2338
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2339
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2340
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2341
     String cachedLookupMethodFor:#=
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2342
     String cachedLookupMethodFor:#asOrderedCollection
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2343
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2344
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2345
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2346
canBeSubclassed
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2347
    "return true, if its allowed to create subclasses of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2348
     This method is redefined in SmallInteger and UndefinedObject, since
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2349
     instances are detected by their pointer-fields, i.e. they do not have
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2350
     a class entry (you dont have to understand this :-)"
10
claus
parents: 5
diff changeset
  2351
claus
parents: 5
diff changeset
  2352
    ^ true
claus
parents: 5
diff changeset
  2353
!
claus
parents: 5
diff changeset
  2354
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2355
canUnderstand:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2356
    "return true, if the receiver or one of its superclasses implements aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2357
     (i.e. true if my instances understand aSelector)"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2358
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2359
    ^ (self lookupMethodFor:aSelector) notNil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2360
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2361
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2362
     True canUnderstand:#ifTrue:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2363
     True canUnderstand:#==
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2364
     True canUnderstand:#do:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2365
    "
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2366
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2367
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2368
compiledMethodAt:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2369
    "return the method for given selector aSelector or nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2370
     Only methods in the receiver - not in the superclass chain are tested."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2371
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2372
    |index|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2373
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2374
    selectorArray isNil ifTrue:[
1088
989f0e510a32 nicer message
Claus Gittinger <cg@exept.de>
parents: 983
diff changeset
  2375
        ('BEHAVIOR: OOPS - nil selectorArray in ' , self name) errorPrintNL.
989f0e510a32 nicer message
Claus Gittinger <cg@exept.de>
parents: 983
diff changeset
  2376
        ^ nil
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2377
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2378
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2379
    index := selectorArray identityIndexOf:aSelector startingAt:1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2380
    (index == 0) ifTrue:[^ nil].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2381
    ^ methodArray at:index
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2382
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2383
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2384
     Object compiledMethodAt:#==
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2385
     (Object compiledMethodAt:#==) category
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2386
    "
1088
989f0e510a32 nicer message
Claus Gittinger <cg@exept.de>
parents: 983
diff changeset
  2387
989f0e510a32 nicer message
Claus Gittinger <cg@exept.de>
parents: 983
diff changeset
  2388
    "Modified: 7.3.1996 / 19:14:23 / cg"
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2389
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2390
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2391
containsMethod:aMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2392
    "Return true, if the argument, aMethod is a method of myself"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2393
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2394
    methodArray isNil ifTrue:[^ false].  "degenerated class"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2395
    ^ (methodArray identityIndexOf:aMethod startingAt:1) ~~ 0
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2396
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2397
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2398
derivedInstanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2399
    "return the number of instances of myself and of subclasses"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2400
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2401
    |count|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2402
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2403
    count := 0.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2404
    ObjectMemory allObjectsDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2405
	(anObject isKindOf:self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2406
	    count := count + 1
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2407
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2408
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2409
    ^ count
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2410
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2411
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2412
     View derivedInstanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2413
     SequenceableCollection derivedInstanceCount
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2414
     Object derivedInstanceCount
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2415
    "
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2416
!
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2417
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2418
hasDerivedInstances
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2419
    "return true, if there are any instances of myself or of any subclass"
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2420
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2421
    "Read the documentation on why there seem to be no
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2422
     instances of SmallInteger and UndefinedObject"
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2423
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2424
    ObjectMemory allObjectsDo:[:anObject |
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2425
	(anObject isKindOf:self) ifTrue:[
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2426
	    ^ true
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2427
	]
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2428
    ].
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2429
    ^ false
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2430
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2431
    "
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2432
     Object hasDerivedInstances         - certainly true
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2433
     SharedQueue hasDerivedInstances
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2434
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2435
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2436
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2437
hasInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2438
    "return true, if there are any instances of myself"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2439
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2440
    "Read the documentation on why there seem to be no
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2441
     instances of SmallInteger and UndefinedObject"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2442
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2443
"/    ObjectMemory allObjectsDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2444
"/        (anObject class == self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2445
"/            ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2446
"/        ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2447
"/    ].
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2448
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2449
    ObjectMemory allInstancesOf:self do:[:anObject |
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2450
	^ true
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2451
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2452
    ^ false
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2453
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2454
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2455
     Object hasInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2456
     SequenceableCollection hasInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2457
     Float hasInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2458
     SmallInteger hasInstances
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2459
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2460
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2461
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2462
hasMethods
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2463
    "return true, if there are any (local) methods in this class"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2464
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2465
    ^ (methodArray size ~~ 0)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2466
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2467
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2468
     True hasMethods
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2469
     True class hasMethods
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2470
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2471
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2472
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2473
hasMultipleSuperclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2474
    "Return true, if this class inherits from other classes 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2475
     (beside its primary superclass). 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2476
     This method is a preparation for a future multiple inheritance extension 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2477
     - currently it is not supported by the VM"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2478
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2479
    ^ otherSuperclasses notNil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2480
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2481
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2482
implements:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2483
    "return true, if the receiver implements aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2484
     (i.e. implemented in THIS class - NOT in a superclass).
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2485
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2486
     Caveat:
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2487
	This simply checks for the selector being present in the classes
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2488
	selector table - therefore, it does not care for ignoredMethods.
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2489
	(but: you should not use this method for protocol-testing, anyway).
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2490
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2491
     Hint:
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2492
	Dont use this method to check if someone responds to a message -
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2493
	use #canUnderstand: on the class or #respondsTo: on the instance
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2494
	to do this."
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2495
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2496
    ^ self includesSelector:aSelector
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2497
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2498
    "
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2499
     notice: this is class protocol
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2500
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2501
       True implements:#ifTrue:  
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2502
       True implements:#==        
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2503
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2504
     notice: this is instance protocol
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2505
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2506
       true respondsTo:#ifTrue:   
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2507
       true respondsTo:#==        
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2508
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2509
     notice: this is class protocol
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2510
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2511
       True canUnderstand:#ifTrue: 
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2512
       True canUnderstand:#==        
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2513
    "
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2514
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2515
    "Modified: 10.2.1996 / 13:15:56 / cg"
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2516
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2517
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2518
includesSelector:aSelector
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2519
    "return true, if the methodArray of THIS class includes
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2520
     a method for aSelector.
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2521
     (i.e. if aSelector is implemented in THIS class - NOT in a superclass).
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2522
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2523
     Hint:
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2524
	Dont use this method to check if someone responds to a message -
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2525
	use #canUnderstand: on the class or #respondsTo: on the instance
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2526
	to do this."
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2527
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2528
    ^ (selectorArray identityIndexOf:aSelector startingAt:1) ~~ 0
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2529
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2530
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2531
inheritsFrom:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2532
    "return true, if the receiver inherits methods from aClass"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2533
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2534
    ^ self isSubclassOf:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2535
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2536
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2537
     True inheritsFrom:Object
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2538
     LinkedList inheritsFrom:Array
356
claus
parents: 345
diff changeset
  2539
    "
357
claus
parents: 356
diff changeset
  2540
!
claus
parents: 356
diff changeset
  2541
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2542
instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2543
    "return the number of instances of myself."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2544
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2545
    "Read the documentation on why there seem to be no
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2546
     instances of SmallInteger and UndefinedObject"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2547
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2548
    |count|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2549
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2550
    count := 0.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2551
"/    ObjectMemory allObjectsDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2552
"/        (anObject class == self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2553
"/            count := count + 1
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2554
"/        ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2555
"/    ].
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2556
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2557
    ObjectMemory allInstancesOf:self do:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2558
	count := count + 1
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2559
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2560
    ^ count
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2561
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2562
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2563
     View instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2564
     Object instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2565
     Float instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2566
     SequenceableCollection instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2567
     SmallInteger instanceCount   .... mhmh - hear, hear
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2568
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2569
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2570
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2571
isBehavior
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2572
    "return true, if the receiver is describing another objects behavior,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2573
     i.e. is a class. Defined to avoid the need to use isKindOf:"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2574
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2575
    ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2576
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2577
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2578
     True isBehavior   
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2579
     true isBehavior
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2580
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2581
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2582
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2583
isBits
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2584
    "return true, if instances have indexed byte or short instance variables.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2585
     Ignore long, float and double arrays, since ST-80 code using isBits are probably
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2586
     not prepared to handle them correctly."
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  2587
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  2588
%{  /* NOCONTEXT */
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2589
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2590
    REGISTER int what;
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2591
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2592
    what = (INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK);
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2593
    RETURN (( (what == __MASKSMALLINT(BYTEARRAY))
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2594
	     || (what == __MASKSMALLINT(WORDARRAY))) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2595
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2596
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2597
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2598
isBytes
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2599
    "return true, if instances have indexed byte instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2600
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2601
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2602
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagBytes
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2603
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2604
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2605
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2606
    RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(BYTEARRAY)) ? true : false ); 
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2607
%}
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2608
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2609
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2610
isDoubles
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2611
    "return true, if instances have indexed double instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2612
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2613
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2614
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagDoubles
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2615
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2616
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2617
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2618
    RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(DOUBLEARRAY)) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2619
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2620
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2621
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2622
isFixed
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2623
    "return true, if instances do not have indexed instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2624
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2625
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2626
	^ self isVariable not
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2627
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2628
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2629
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2630
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2631
    RETURN ( ((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) ? false : true ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2632
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2633
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2634
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2635
isFloats
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2636
    "return true, if instances have indexed float instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2637
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2638
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2639
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagFloats
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2640
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2641
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2642
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2643
    RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(FLOATARRAY)) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2644
%}
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2645
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2646
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2647
isFloatsOrDoubles
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2648
    "return true, if instances have indexed float or double instance variables"
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2649
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2650
%{  /* NOCONTEXT */
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2651
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2652
    int what;
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2653
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2654
    what = (INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK);
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2655
    RETURN (( (what == __MASKSMALLINT(FLOATARRAY))
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2656
	     || (what == __MASKSMALLINT(DOUBLEARRAY))) ? true : false ); 
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2657
%}
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2658
    "
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2659
     (Object new) class isFloatsOrDoubles 
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2660
     (Point new) class isFloatsOrDoubles   
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2661
     (Array new) class isFloatsOrDoubles   
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2662
     (ByteArray new) class isFloatsOrDoubles  
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2663
     (FloatArray new) class isFloatsOrDoubles  
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2664
     (DoubleArray new) class isFloatsOrDoubles  
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2665
    "
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2666
!
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2667
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2668
isLongs
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2669
    "return true, if instances have indexed long instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2670
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2671
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2672
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagLongs
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2673
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2674
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2675
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2676
    RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(LONGARRAY)) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2677
%}
356
claus
parents: 345
diff changeset
  2678
!
claus
parents: 345
diff changeset
  2679
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2680
isPointers
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2681
    "return true, if instances have pointer instance variables 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2682
     i.e. are either non-indexed or have indexed pointer variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2683
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2684
    "QUESTION: should we ignore WeakPointers ?"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2685
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2686
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2687
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2688
    REGISTER int flags;
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2689
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2690
    flags = __intVal(__INST(flags)) & ARRAYMASK;
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2691
    switch (flags) {
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2692
	default:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2693
	    /* normal objects */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2694
	    RETURN ( true );
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2695
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2696
	case BYTEARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2697
	case WORDARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2698
	case LONGARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2699
	case FLOATARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2700
	case DOUBLEARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2701
	    RETURN (false );
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2702
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2703
	case WKPOINTERARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2704
	    /* what about those ? */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2705
	    RETURN (true );
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2706
    }
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2707
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2708
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2709
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2710
isSubclassOf:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2711
    "return true, if I am a subclass of the argument, aClass"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2712
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2713
    |theClass|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2714
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2715
    theClass := superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2716
    [theClass notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2717
	(theClass == aClass) ifTrue:[^ true].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2718
%{
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2719
	if (__isBehaviorLike(theClass)) {
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2720
	    theClass = __ClassInstPtr(theClass)->c_superclass;
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2721
	} else {
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2722
	    theClass = nil;
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2723
	}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2724
%}.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2725
"/        theClass := theClass superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2726
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2727
    ^ false
356
claus
parents: 345
diff changeset
  2728
claus
parents: 345
diff changeset
  2729
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2730
     String isSubclassOf:Collection  
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2731
     LinkedList isSubclassOf:Array   
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2732
     1 isSubclassOf:Number              <- will fail since 1 is no class
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2733
    "     
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2734
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2735
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2736
isVariable
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2737
    "return true, if instances have indexed instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2738
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2739
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2740
	^ (flags bitAnd:(Behavior maskIndexType)) ~~ 0
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2741
     "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2742
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2743
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2744
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2745
    RETURN ( ((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2746
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2747
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2748
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2749
isWords
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2750
    "return true, if instances have indexed short instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2751
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2752
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2753
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagWords
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2754
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2755
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2756
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2757
    RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(WORDARRAY)) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2758
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2759
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2760
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2761
lookupMethodFor:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2762
    "return the method, which would be executed if aSelector was sent to
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2763
     an instance of the receiver. I.e. the selector arrays of the receiver
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2764
     and all of its superclasses are searched for aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2765
     Return the method, or nil if instances do not understand aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2766
     EXPERIMENTAL: take care of multiple superclasses."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2767
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2768
    |m cls|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2769
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2770
    cls := self.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2771
    [cls notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2772
	m := cls compiledMethodAt:aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2773
	m notNil ifTrue:[^ m].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2774
	cls hasMultipleSuperclasses ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2775
	    cls superclasses do:[:aSuperClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2776
		m := aSuperClass lookupMethodFor:aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2777
		m notNil ifTrue:[^ m].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2778
	    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2779
	    ^ nil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2780
	] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2781
	    cls := cls superclass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2782
	]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2783
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2784
    ^ nil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2785
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2786
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2787
selectorAtMethod:aMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2788
    "Return the selector for given method aMethod."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2789
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2790
    ^ self selectorAtMethod:aMethod ifAbsent:[nil]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2791
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2792
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2793
     |m|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2794
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2795
     m := Object compiledMethodAt:#copy.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2796
     Fraction selectorAtMethod:m.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2797
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2798
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2799
     |m|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2800
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2801
     m := Object compiledMethodAt:#copy.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2802
     Object selectorAtMethod:m.
356
claus
parents: 345
diff changeset
  2803
    "
claus
parents: 345
diff changeset
  2804
!
claus
parents: 345
diff changeset
  2805
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2806
selectorAtMethod:aMethod ifAbsent:failBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2807
    "return the selector for given method aMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2808
     or the value of failBlock, if not found."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2809
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2810
    |index|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2811
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2812
    index := methodArray identityIndexOf:aMethod startingAt:1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2813
    (index == 0) ifTrue:[^ failBlock value].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2814
    ^ selectorArray at:index
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2815
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2816
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2817
     |m|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2818
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2819
     m := Object compiledMethodAt:#copy.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2820
     Object selectorAtMethod:m ifAbsent:['oops'].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2821
    "
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2822
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2823
     |m|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2824
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2825
     m := Object compiledMethodAt:#copy.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2826
     Fraction selectorAtMethod:m ifAbsent:['oops'].
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2827
    "
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2828
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2829
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2830
selectorIndex:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2831
    "return the index in the arrays for given selector aSelector"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2832
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2833
    ^ selectorArray identityIndexOf:aSelector startingAt:1
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2834
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2835
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2836
sizeOfInst:n
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2837
    "return the number of bytes required for an instance of
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2838
     myself with n indexed instance variables. The argument n 
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2839
     should be zero for classes without indexed instance variables.
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2840
     See Behavior>>niceNew: for an application of this."
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2841
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2842
    |nInstvars|
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2843
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2844
    nInstvars := self instSize.
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2845
%{
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2846
    int nBytes;
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2847
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2848
    nBytes = __intVal(nInstvars) * sizeof(OBJ) + OHDR_SIZE; 
249
claus
parents: 216
diff changeset
  2849
    if (__isSmallInteger(n)) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2850
	int nIndex;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2851
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2852
	nIndex = __intVal(n);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2853
	switch (__intVal(__INST(flags)) & ARRAYMASK) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2854
	    case BYTEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2855
		nBytes += nIndex;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2856
		if (nBytes & (ALIGN - 1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2857
		    nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2858
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2859
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2860
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2861
	    case WORDARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2862
		nBytes += nIndex * sizeof(short);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2863
		if (nBytes & (ALIGN - 1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2864
		    nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2865
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2866
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2867
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2868
	    case LONGARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2869
		nBytes += nIndex * sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2870
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2871
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2872
	    case FLOATARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2873
		nBytes += nIndex * sizeof(float);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2874
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2875
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2876
	    case DOUBLEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2877
		nBytes += nIndex * sizeof(double);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2878
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2879
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2880
	    default:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2881
		nBytes += nIndex * sizeof(OBJ);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2882
		break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2883
	}
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2884
    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  2885
    RETURN (__MKSMALLINT(nBytes));
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2886
%}
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2887
!
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2888
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2889
sourceCodeAt:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2890
    "return the methods source for given selector aSelector or nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2891
     Only methods in the receiver - not in the superclass chain are tested."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2892
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2893
    |method|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2894
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2895
    method := self compiledMethodAt:aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2896
    method isNil ifTrue:[^ nil].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2897
    ^ method source
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2898
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2899
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2900
     True sourceCodeAt:#ifTrue:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2901
     Object sourceCodeAt:#==
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2902
     Behavior sourceCodeAt:#sourceCodeAt:
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2903
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2904
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2905
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2906
subclasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2907
    "return a collection of the direct subclasses of the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2908
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2909
    |newColl|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2910
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2911
    SubclassInfo notNil ifTrue:[
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2912
	newColl := SubclassInfo at:self ifAbsent:nil.
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2913
	newColl notNil ifTrue:[^ newColl asOrderedCollection]
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2914
    ].
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2915
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2916
    newColl := OrderedCollection new.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2917
    self subclassesDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2918
	newColl add:aClass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2919
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2920
    ^ newColl
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2921
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2922
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2923
     Collection subclasses
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2924
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2925
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2926
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2927
superclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2928
    "return a collection of the receivers immediate superclasses.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2929
     This method is a preparation for a future multiple inheritance extension 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2930
     - currently it is not supported by the VM"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2931
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2932
    |a|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2933
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2934
    a := Array with:superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2935
    otherSuperclasses notNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2936
	^ a , otherSuperclasses
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2937
    ].
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2938
    ^ a
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2939
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2940
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2941
     String superclasses  
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2942
    "
2
claus
parents: 1
diff changeset
  2943
!
claus
parents: 1
diff changeset
  2944
claus
parents: 1
diff changeset
  2945
whichClassImplements:aSelector
328
claus
parents: 325
diff changeset
  2946
    "obsolete interface;
claus
parents: 325
diff changeset
  2947
     use whichClassIncludesSelector: for ST-80 compatibility."
claus
parents: 325
diff changeset
  2948
claus
parents: 325
diff changeset
  2949
    ^ self whichClassIncludesSelector:aSelector
claus
parents: 325
diff changeset
  2950
!
claus
parents: 325
diff changeset
  2951
claus
parents: 325
diff changeset
  2952
whichClassIncludesSelector:aSelector
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2953
    "return the class in the inheritance chain, which implements the method
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2954
     for aSelector; return nil if none.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2955
     EXPERIMENTAL: handle multiple superclasses"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2956
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2957
    |cls|
2
claus
parents: 1
diff changeset
  2958
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2959
    cls := self.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2960
    [cls notNil] whileTrue:[
983
86239edb7b7d change in VM data structures
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  2961
	(cls includesSelector:aSelector) ifTrue:[^ cls].
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2962
	cls hasMultipleSuperclasses ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2963
	    cls superclasses do:[:aSuperClass |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2964
		|implementingClass|
2
claus
parents: 1
diff changeset
  2965
328
claus
parents: 325
diff changeset
  2966
		implementingClass := aSuperClass whichClassIncludesSelector:aSelector.
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2967
		implementingClass notNil ifTrue:[^ implementingClass].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2968
	    ].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2969
	    ^ nil
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2970
	] ifFalse:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2971
	    cls := cls superclass
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2972
	]
2
claus
parents: 1
diff changeset
  2973
    ].
claus
parents: 1
diff changeset
  2974
    ^ nil
claus
parents: 1
diff changeset
  2975
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2976
    "
328
claus
parents: 325
diff changeset
  2977
     String whichClassIncludesSelector:#==
claus
parents: 325
diff changeset
  2978
     String whichClassIncludesSelector:#collect:
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2979
    "
2
claus
parents: 1
diff changeset
  2980
!
claus
parents: 1
diff changeset
  2981
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2982
withAllSubclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2983
    "return a collection containing the receiver and 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2984
     all subclasses (direct AND indirect) of the receiver"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2985
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2986
    |newColl|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2987
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2988
    newColl := OrderedCollection with:self.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2989
    self allSubclassesDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2990
	newColl add:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2991
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2992
    ^ newColl
328
claus
parents: 325
diff changeset
  2993
claus
parents: 325
diff changeset
  2994
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2995
     Collection withAllSubclasses
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2996
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2997
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2998
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2999
withAllSuperclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3000
    "return a collection containing the receiver and all
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3001
     of the receivers accumulated superclasses"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3002
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3003
    |aCollection theSuperClass|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3004
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3005
    aCollection := OrderedCollection with:self.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3006
    theSuperClass := superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3007
    [theSuperClass notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3008
	aCollection add:theSuperClass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3009
	theSuperClass := theSuperClass superclass
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  3010
    ].
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3011
    ^ aCollection
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  3012
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  3013
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3014
     String withAllSuperclasses 
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  3015
    "
2
claus
parents: 1
diff changeset
  3016
! !
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3017
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3018
!Behavior methodsFor:'snapshots'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3019
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3020
postSnapshot
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3021
    "sent by ObjectMemory, after a snapshot has been written.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3022
     Nothing done here."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3023
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3024
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3025
preSnapshot
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3026
    "sent by ObjectMemory, before a snapshot is written.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3027
     Nothing done here."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3028
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  3029
662
df7953db3847 version method at the end
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
  3030
!Behavior class methodsFor:'documentation'!
df7953db3847 version method at the end
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
  3031
df7953db3847 version method at the end
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
  3032
version
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1088
diff changeset
  3033
    ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.66 1996-04-02 21:58:42 cg Exp $'
662
df7953db3847 version method at the end
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
  3034
! !