Behavior.st
author Claus Gittinger <cg@exept.de>
Sat, 16 Dec 1995 14:04:33 +0100
changeset 778 afbb3ebde874
parent 759 908363ce8a32
child 788 e80f1c42b87b
permissions -rw-r--r--
commentary
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
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
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'
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
    16
	 classVariableNames:'SubclassInfo'
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
    17
	 poolDictionaries:''
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   300
    RETURN ( _MKSMALLINT(BEHAVIOR_INSTS) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   341
    RETURN ( _MKSMALLINT(BLOCK_INSTS) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   353
    RETURN ( _MKSMALLINT(BCONTEXT_INSTS) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   365
    RETURN ( _MKSMALLINT(BYTEARRAY) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   380
    RETURN ( _MKSMALLINT(CONTEXT_INSTS) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   392
    RETURN ( _MKSMALLINT(DOUBLEARRAY) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   407
    RETURN ( _MKSMALLINT(FLOAT_INSTS) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   419
    RETURN ( _MKSMALLINT(FLOATARRAY) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   434
    RETURN ( _MKSMALLINT(LONGARRAY) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   449
    RETURN ( _MKSMALLINT(METHOD_INSTS) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   461
    RETURN ( _MKSMALLINT(NONOBJECT_INSTS) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   481
    RETURN ( _MKSMALLINT(POINTERARRAY) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   496
    RETURN ( _MKSMALLINT(SYMBOL_INSTS) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   508
    RETURN ( _MKSMALLINT(WKPOINTERARRAY) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   520
    RETURN ( _MKSMALLINT(WORDARRAY) );
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   533
    RETURN ( _MKSMALLINT(ARRAYMASK) );
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;
369
claus
parents: 362
diff changeset
  1361
    extern OBJ __new();
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1362
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1363
    /*
369
claus
parents: 362
diff changeset
  1364
     * the following ugly code is nothing more than a __new() followed
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1365
     * by a nilling of the new instance.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1366
     * Unrolled for a bit more speed since this is one of the central object 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1367
     * allocation methods in the system
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1368
     */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1369
    nInstVars = _intVal(_INST(instSize));
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1370
    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1371
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1372
    newobj = (OBJ) newNextPtr;
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1373
    nextPtr = ((char *)newobj) + instsize;
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1374
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1375
    /*
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1376
     * dont argue about the goto and the arrangement below - it saves 
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1377
     * an extra nil-compare and branch in the common case ...
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1378
     * (i.e. if no GC is needed, we fall through without a branch)
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1379
     */
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1380
    if (nextPtr < newEndPtr) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1381
	_objPtr(newobj)->o_size = instsize;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1382
	/* o_allFlags(newobj) = 0;              */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1383
	/* _objPtr(newobj)->o_space = newSpace; */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1384
	o_setAllFlags(newobj, newSpace);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1385
#ifdef ALIGN4
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1386
	newNextPtr = nextPtr;
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1387
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1388
	if (instsize & (ALIGN-1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1389
	    newNextPtr = (char *)newobj + (instsize & ~(ALIGN-1)) + ALIGN;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1390
	} else {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1391
	    newNextPtr = nextPtr;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1392
	}
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1393
#endif
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1394
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1395
ok:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1396
	_InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1397
	__qSTORE(newobj, self);
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1398
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1399
	if (nInstVars) {
357
claus
parents: 356
diff changeset
  1400
#if defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1401
	    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1402
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1403
	    REGISTER OBJ *op;
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1404
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1405
	    op = _InstPtr(newobj)->i_instvars;
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1406
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1407
# if !defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1408
	    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1409
	     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1410
	     */
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1411
#  if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1412
	    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1413
		*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1414
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1415
		while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1416
		    *(double *)op = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1417
		    ((double *)op)[1] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1418
		    ((double *)op)[2] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1419
		    ((double *)op)[3] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1420
		    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1421
		    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1422
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1423
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1424
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1425
		*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1426
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1427
	    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1428
#  else
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1429
#   if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1430
	    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1431
		*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1432
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1433
		while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1434
		    *(long long *)op = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1435
		    ((long long *)op)[1] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1436
		    ((long long *)op)[2] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1437
		    ((long long *)op)[3] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1438
		    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1439
		    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1440
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1441
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1442
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1443
		*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1444
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1445
	    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1446
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1447
#   else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1448
#    if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1449
	    while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1450
		*op = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1451
		*(op+1) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1452
		*(op+2) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1453
		*(op+3) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1454
		*(op+4) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1455
		*(op+5) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1456
		*(op+6) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1457
		*(op+7) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1458
		op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1459
		nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1460
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1461
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1462
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1463
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1464
	    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1465
#    else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1466
#     if defined(FAST_MEMSET)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1467
	    memset(_InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1468
#     else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1469
	    do {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1470
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1471
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1472
	    } while (nInstVars != 0);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1473
#     endif
82
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
#  endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1477
# else /* nil could be ~~ 0 */
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1478
	    while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1479
		*op = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1480
		*(op+1) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1481
		*(op+2) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1482
		*(op+3) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1483
		*(op+4) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1484
		*(op+5) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1485
		*(op+6) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1486
		*(op+7) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1487
		op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1488
		nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1489
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1490
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1491
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1492
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1493
	    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1494
# endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1495
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1496
	}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1497
	RETURN ( newobj );
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
  1498
    }
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1499
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1500
    /*
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1501
     * the slow case - a GC will occur
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1502
     */
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1503
    PROTECT_CONTEXT
369
claus
parents: 362
diff changeset
  1504
    newobj = __new(instsize);
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1505
    UNPROTECT_CONTEXT
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1506
    if (newobj != nil) goto ok;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1507
%}
2
claus
parents: 1
diff changeset
  1508
.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1509
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1510
     memory allocation failed.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1511
     When we arrive here, there was no memory, even after
165
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1512
     a garbage collect. 
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1513
     This means, that the VM wanted to get some more memory from the 
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1514
     Operatingsystem, which was not kind enough to give it.
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1515
     Bad luck - you should increase the swap space on your machine.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1516
    "
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1517
    ^ ObjectMemory allocationFailureSignal raise.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1518
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1519
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1520
basicNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1521
    "return an instance of myself with anInteger indexed variables.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1522
     If the receiver-class has no indexed instvars, this is only allowed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1523
     if the argument, anInteger is zero.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1524
     ** Do not redefine this method in any class **"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1525
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1526
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1527
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1528
    OBJ newobj;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1529
    unsigned INT instsize, nInstVars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1530
    INT nindexedinstvars;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1531
    unsigned INT flags;
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1532
#if ! defined(FAST_ARRAY_MEMSET) || defined(NEGATIVE_ADDRESSES)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1533
    REGISTER char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1534
    short *sp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1535
    long *lp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1536
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1537
    REGISTER OBJ *op;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1538
    float *fp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1539
    double *dp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1540
249
claus
parents: 216
diff changeset
  1541
    if (__isSmallInteger(anInteger)) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1542
	nindexedinstvars = _intVal(anInteger);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1543
	if (nindexedinstvars >= 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1544
	    nInstVars = _intVal(_INST(instSize));
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1545
	    flags = _intVal(_INST(flags)) & ARRAYMASK;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1546
	    switch (flags) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1547
		case BYTEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1548
		    instsize = OHDR_SIZE + nindexedinstvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1549
		    if (nInstVars == 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1550
			if (_CanDoQuickNew(instsize)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1551
			    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1552
			     * the most common case
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1553
			     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1554
			    _qCheckedNew(newobj, instsize);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1555
			    _InstPtr(newobj)->o_class = self;
357
claus
parents: 356
diff changeset
  1556
#if defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
359
claus
parents: 357
diff changeset
  1557
			    nInstVars = nindexedinstvars >> 2;
claus
parents: 357
diff changeset
  1558
			    if (nindexedinstvars & 3) nInstVars++;
claus
parents: 357
diff changeset
  1559
			    memset4(_InstPtr(newobj)->i_instvars, 0, nInstVars);
357
claus
parents: 356
diff changeset
  1560
#else
claus
parents: 356
diff changeset
  1561
# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1562
			    memset(_InstPtr(newobj)->i_instvars, 0, nindexedinstvars);
357
claus
parents: 356
diff changeset
  1563
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1564
			    cp = (char *)_InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1565
			    while (nindexedinstvars >= sizeof(long)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1566
				*(long *)cp = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1567
				cp += sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1568
				nindexedinstvars -= sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1569
			    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1570
			    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1571
				*cp++ = '\0';
357
claus
parents: 356
diff changeset
  1572
# endif
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1573
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1574
			    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1575
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1576
		    } else {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1577
			instsize += __OBJS2BYTES__(nInstVars);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1578
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1579
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1580
		    _qNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1581
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1582
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1583
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1584
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1585
		    _InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1586
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1587
357
claus
parents: 356
diff changeset
  1588
#if defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
claus
parents: 356
diff changeset
  1589
		    nInstVars = (instsize-OHDR_SIZE) >> 2;
claus
parents: 356
diff changeset
  1590
		    if (instsize & 3) nInstVars++;
claus
parents: 356
diff changeset
  1591
		    memset4(_InstPtr(newobj)->i_instvars, 0, nInstVars);
claus
parents: 356
diff changeset
  1592
#else
claus
parents: 356
diff changeset
  1593
# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1594
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1595
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1596
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1597
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
357
claus
parents: 356
diff changeset
  1598
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1599
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1600
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1601
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1602
		    cp = (char *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1603
		    while (nindexedinstvars >= sizeof(long)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1604
			*(long *)cp = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1605
			cp += sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1606
			nindexedinstvars -= sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1607
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1608
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1609
			*cp++ = '\0';
357
claus
parents: 356
diff changeset
  1610
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1611
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1612
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1613
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1614
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1615
		case WORDARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1616
		    instsize = OHDR_SIZE + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1617
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1618
			       nindexedinstvars * sizeof(short);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1619
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1620
		    _qNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1621
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1622
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1623
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1624
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1625
		    _InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1626
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1627
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1628
#if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1629
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1630
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1631
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1632
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1633
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1634
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1635
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1636
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1637
		    sp = (short *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1638
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1639
			*sp++ = 0;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1640
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1641
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1642
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1643
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1644
	       case LONGARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1645
		    instsize = OHDR_SIZE + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1646
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1647
			       nindexedinstvars * sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1648
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1649
		    _qAlignedNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1650
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1651
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1652
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1653
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1654
		    _InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1655
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1656
357
claus
parents: 356
diff changeset
  1657
#if defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1658
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1659
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1660
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1661
		    memset4(_InstPtr(newobj)->i_instvars, 0, nInstVars + nindexedinstvars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1662
#else
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1663
# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1664
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1665
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1666
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1667
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1668
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1669
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1670
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1671
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1672
		    lp = (long *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1673
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1674
			*lp++ = 0;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1675
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1676
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1677
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1678
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1679
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1680
	       case FLOATARRAY:
325
claus
parents: 323
diff changeset
  1681
		    instsize = sizeof(struct __floatArray) + 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1682
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1683
			       (nindexedinstvars - 1) * sizeof(float);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1684
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1685
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1686
		    _qNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1687
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1688
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1689
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1690
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1691
		    _InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1692
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1693
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1694
		    op = _InstPtr(newobj)->i_instvars;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1695
# if defined(mips) /* knowin that float 0.0 is all-zeros */
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1696
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1697
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1698
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1699
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1700
		    fp = (float *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1701
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1702
			*fp++ = 0.0;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1703
# endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1704
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1705
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1706
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1707
	       case DOUBLEARRAY:
325
claus
parents: 323
diff changeset
  1708
		    instsize = sizeof(struct __doubleArray) + 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1709
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1710
			       (nindexedinstvars - 1) * sizeof(double);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1711
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1712
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1713
		    _qAlignedNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1714
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1715
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1716
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1717
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1718
		    _InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1719
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1720
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1721
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1722
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1723
			*op++ = nil;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1724
#ifdef NEED_DOUBLE_ALIGN
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1725
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1726
		     * care for double alignment
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1727
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1728
		    if ((INT)op & (ALIGN-1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1729
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1730
		    }
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
  1731
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1732
		    dp = (double *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1733
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1734
			*dp++ = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1735
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1736
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1737
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1738
		case WKPOINTERARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1739
		case POINTERARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1740
		    nInstVars += nindexedinstvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1741
		    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1742
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1743
		    _qAlignedNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1744
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1745
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1746
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1747
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1748
		    _InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1749
		    __qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1750
357
claus
parents: 356
diff changeset
  1751
#if defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1752
		    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1753
#else
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1754
# if !defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1755
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1756
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1757
		     */
360
claus
parents: 359
diff changeset
  1758
#ifdef XXmips
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1759
# undef FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1760
# undef FAST_ARRAY_MEMSET_LONGLONG_UNROLLED
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1761
/* seems to be slightly faster */
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1762
# define FAST_ARRAY_MEMSET
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1763
#endif
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1764
#ifdef sparc
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1765
# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1766
#endif
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1767
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1768
#  if defined(FAST_ARRAY_MEMSET_DOUBLES_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1769
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1770
		    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1771
			*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1772
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1773
			while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1774
			    *(double *)op = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1775
			    ((double *)op)[1] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1776
			    ((double *)op)[2] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1777
			    ((double *)op)[3] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1778
			    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1779
			    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1780
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1781
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1782
		    while (nInstVars) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1783
			*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1784
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1785
		    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1786
#  else
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1787
#   if defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1788
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1789
		    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1790
			*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1791
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1792
			while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1793
			    *(long long *)op = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1794
			    ((long long *)op)[1] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1795
			    ((long long *)op)[2] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1796
			    ((long long *)op)[3] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1797
			    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1798
			    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1799
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1800
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1801
		    while (nInstVars) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1802
			*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1803
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1804
		    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1805
#   else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1806
#    if defined(FAST_ARRAY_MEMSET)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1807
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1808
#    else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1809
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1810
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1811
			*op++ = nil;
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1812
#    endif
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1813
#   endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1814
#  endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
  1815
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1816
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1817
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1818
			*op++ = nil;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1819
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1820
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1821
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1822
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1823
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1824
		default:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1825
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1826
		     * new:n for non-variable classes only allowed if
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1827
		     * n == 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1828
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1829
		    if (nindexedinstvars == 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1830
			instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1831
			PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1832
			_qAlignedNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1833
			UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1834
			if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1835
			    break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1836
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1837
			_InstPtr(newobj)->o_class = self;
369
claus
parents: 362
diff changeset
  1838
			__qSTORE(newobj, self);
claus
parents: 362
diff changeset
  1839
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1840
			if (nInstVars) {
357
claus
parents: 356
diff changeset
  1841
#if defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1842
			    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1843
#else
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1844
# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1845
			    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1846
			     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1847
			     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1848
			    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1849
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1850
			    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1851
			    do {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1852
				*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1853
			    } while (--nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1854
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1855
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1856
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1857
			RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1858
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1859
		    break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1860
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1861
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1862
    }
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1863
%}.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1864
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1865
     arrive here if something went wrong ...
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1866
     figure out what it was
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1867
    "
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1868
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1869
    (anInteger isMemberOf:SmallInteger) ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1870
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1871
	 the argument is either not an integer,
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1872
	 or a LargeInteger (which means that its definitely too big)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1873
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1874
	self error:'argument to new: must be Integer'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1875
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1876
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1877
    (anInteger < 0) ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1878
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1879
	 the argument is negative,
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1880
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1881
	self error:'bad (negative) argument to new:'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1882
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1883
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1884
    self isVariable ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1885
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1886
	 this class does not have any indexed instance variables
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1887
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1888
	self error:'class has no indexed instvars - cannot create with new:'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1889
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1890
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1891
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1892
     memory allocation failed.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1893
     When we arrive here, there was no memory, even after
165
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1894
     a garbage collect. 
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1895
     This means, that the VM wanted to get some more memory from the 
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1896
     Operatingsystem, which was not kind enough to give it.
63341654cfb8 *** empty log message ***
claus
parents: 154
diff changeset
  1897
     Bad luck - you should increase the swap space on your machine.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1898
    "
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1899
    ^ ObjectMemory allocationFailureSignal raise.
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1900
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1901
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1902
new
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1903
    "return an instance of myself without indexed variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1904
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1905
    ^ self basicNew
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1908
new:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1909
    "return an instance of myself with anInteger indexed variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1910
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1911
    ^ self basicNew:anInteger
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1914
niceBasicNew:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1915
    "same as basicNew:anInteger, but tries to avoid long pauses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1916
     due to garbage collection. This method checks to see if
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1917
     allocation is possible without a pause, and does a background
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1918
     incremental garbage collect first if there is not enough memory
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1919
     available at the moment for fast allocation. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1920
     This is useful in low-priority background processes which like to 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1921
     avoid disturbing any higher priority foreground process while allocating
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1922
     big amounts of memory. Of course, using this method only makes
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1923
     sense for big or huge objects (say > 200k).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1924
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1925
     EXPERIMENTAL: this is a non-standard interface and should only 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1926
     be used for special applications. There is no guarantee, that this
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1927
     method will be available in future ST/X releases."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1928
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1929
    |size|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1930
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1931
    size := self sizeOfInst:anInteger.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1932
    (ObjectMemory checkForFastNew:size) ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1933
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1934
	 incrementally collect garbage
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1935
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1936
	ObjectMemory incrementalGC.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1937
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1938
    ^ self basicNew:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1939
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1940
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1941
readFrom:aStream
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  1942
    "read an objects printed representation from the argument, aStream 
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  1943
     and return it. 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1944
     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
  1945
     This is the reverse operation to 'storeOn:'.
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  1946
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1947
     WARNING: storeOn: does not handle circular references and multiple 
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1948
	      references to the same object.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1949
	      Use #storeBinary:/readBinaryFrom: for this."
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1950
345
claus
parents: 343
diff changeset
  1951
    ^ self readFrom:aStream onError:[self error:'expected: ' , self name]
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1952
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1953
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1954
     |s|
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1955
     s := WriteStream on:String new.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1956
     #(1 2 3 4) storeOn:s.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1957
     Object readFrom:(ReadStream on:s contents)  
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1958
    "
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1959
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  1960
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1961
readFrom:aStream onError:exceptionBlock
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1962
    "read an objects printed representation from the argument, aStream 
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1963
     and return it (i.e. the stream should contain some representation of
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1964
     the object which was created using #storeOn:). 
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1965
     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
  1966
     exceptionBlock is returned.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1967
     To get any object, use 'Object readFrom:...',
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1968
     To get any number, use 'Number readFrom:...' and so on.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1969
     This is the reverse operation to 'storeOn:'.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1970
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1971
     WARNING: storeOn: does not handle circular references and multiple 
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1972
	      references to the same object.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1973
	      Use #storeBinary:/readBinaryFrom: for this."
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1974
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1975
    |newObject|
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1976
340
claus
parents: 331
diff changeset
  1977
    ErrorSignal handle:[:ex |
claus
parents: 331
diff changeset
  1978
	ex return
claus
parents: 331
diff changeset
  1979
    ] do:[
345
claus
parents: 343
diff changeset
  1980
	newObject := self evaluatorClass evaluate:aStream.
340
claus
parents: 331
diff changeset
  1981
    ].
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1982
    (newObject isKindOf:self) ifFalse:[^ exceptionBlock value].
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1983
    ^ newObject
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1984
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1985
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1986
     |s|
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1987
     s := WriteStream on:String new.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1988
     #(1 2 3 4) storeOn:s.
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1989
     Transcript showCr:(
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1990
	Array readFrom:(ReadStream on:s contents) onError:'not an Array'
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1991
     )
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1992
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1993
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1994
     |s|
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1995
     s := WriteStream on:String new.
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  1996
     #[1 2 3 4] storeOn:s.
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1997
     Transcript showCr:(
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  1998
	 Array readFrom:(ReadStream on:s contents) onError:'not an Array'
345
claus
parents: 343
diff changeset
  1999
     )
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2000
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2001
!
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2002
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2003
readFromString:aString
275
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2004
    "create an object from its printed representation.
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2005
     For most classes, the string is expected to be in a format created by
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2006
     storeOn: or storeString; however, some (Time, Date) expect a user
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2007
     readable string here.
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2008
     See comments in Behavior>>readFromString:onError:,
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2009
     Behavior>>readFrom: and Behavior>>readFrom:onError:"
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2010
345
claus
parents: 343
diff changeset
  2011
    ^ self readFromString:aString onError:[self error:'expected: ' , self name]
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2012
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2013
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2014
     Integer readFromString:'12345678901234567890' 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2015
     Point readFromString:'1@2'  
345
claus
parents: 343
diff changeset
  2016
     Point readFromString:'1'  
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2017
    "
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2018
!
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2019
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2020
readFromString:aString onError:exceptionBlock
275
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2021
    "create an object from its printed representation.
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2022
     Here, the string is expected to be in a format created by
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2023
     storeOn: or storeString; however, some classes (Time, Date) may redefine
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2024
     it to expect a user readable string here.
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2025
     See comments in Behavior>>readFrom: and Behavior>>readFrom:onError:"
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2026
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2027
    ^ self readFrom:(ReadStream on:aString) onError:exceptionBlock
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2028
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2029
    "
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2030
     Integer readFromString:'12345678901234567890' 
275
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2031
     Integer readFromString:'abc' 
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2032
     Integer readFromString:'abc' onError:0
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2033
     Point readFromString:'1@2'  
345
claus
parents: 343
diff changeset
  2034
     Point readFromString:'0'   
275
a76029ddaa98 *** empty log message ***
claus
parents: 249
diff changeset
  2035
     Point readFromString:'0' onError:[0@0]  
198
d0d0e3910c98 added readFrom:onError: / binaryReadFrom:onError:
claus
parents: 165
diff changeset
  2036
    "
620
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2039
uninitializedNew
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2040
    "create an instance of myself with uninitialized contents.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2041
     For all classes except ByteArray, this is the same as #basicNew."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2042
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2043
    ^ self basicNew
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2046
uninitializedNew:anInteger
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2047
    "create an instance of myself with uninitialized contents.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2048
     For all classes except ByteArray, this is the same as #basicNew:."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2049
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2050
    ^ self basicNew:anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2051
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2052
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2053
!Behavior methodsFor:'private accessing'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2054
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2055
flags:aNumber
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2056
    "set the flags.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2057
     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
  2058
     and no change record written here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2059
     Do NOT use it."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2060
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2061
    flags := aNumber
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2064
instSize:aNumber
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2065
    "set the instance size.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2066
     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
  2067
     and no change record written here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2068
     Do NOT use it."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2069
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2070
    instSize := aNumber
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2073
primAddSelector:newSelector withMethod:newMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2074
    "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
  2075
     the 1st argument to the methodDictionary. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2076
     Does NOT flush any caches, does NOT write a change record.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2077
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2078
     Do not use this in normal situations, strange behavior will be
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2079
     the consequence.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2080
     I.e. executing obsolete methods, since the old method will still 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2081
     be executed out of the caches."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2082
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2083
    |index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2084
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2085
    (newSelector isMemberOf:Symbol) ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2086
	self error:'invalid selector'. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2087
	^ false
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2088
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2089
    newMethod isNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2090
	self error:'invalid method'. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2091
	^ false
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2094
    index := selectorArray identityIndexOf:newSelector startingAt:1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2095
    (index == 0) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2096
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2097
	 a new selector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2098
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2099
	newSelectorArray := selectorArray copyWith:newSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2100
	newMethodArray := methodArray copyWith:newMethod.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2101
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2102
	 keep a reference so they wont go away ...
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2103
	 mhmh: this is no longer needed - try without
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2104
	"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2105
	oldSelectorArray := selectorArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2106
	oldMethodArray := methodArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2107
	selectorArray := newSelectorArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2108
	methodArray := newMethodArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2109
    ] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2110
	methodArray at:index put:newMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2111
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2112
    ^ true
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2115
setMethodArray:anArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2116
    "set the method array of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2117
     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
  2118
     and no change record written here.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2119
     NOT for general use."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2120
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2121
    methodArray := anArray
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2124
setMethodDictionary:aDictionary
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2125
    "set the receivers method dictionary. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2126
     Since no dictionary is actually used, decompose into selector- and
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2127
     method arrays and set those. For ST-80 compatibility.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2128
     NOT for general use."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2129
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2130
    |n newSelectorArray newMethodArray idx|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2131
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2132
    n := aDictionary size.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2133
    newSelectorArray := Array basicNew:n.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2134
    newMethodArray := Array basicNew:n.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2135
    idx := 1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2136
    aDictionary keysAndValuesDo:[:sel :method |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2137
	newSelectorArray at:idx put:sel.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2138
	newMethodArray at:idx put:method.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2139
	idx := idx + 1
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2140
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2141
    selectorArray := newSelectorArray.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2142
    methodArray := newMethodArray
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2145
setOtherSuperclasses:anArrayOfClasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2146
    "EXPERIMENTAL: set the other superclasses of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2147
     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
  2148
     and no change record written here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2149
     Do NOT use it."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2150
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2151
    SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2152
    otherSuperclasses := anArrayOfClasses
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2155
setSelectorArray:anArray
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2156
    "set the selector array of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2157
     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
  2158
     and no change record written here.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2159
     NOT for general use."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2160
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2161
    selectorArray := anArray
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2164
setSelectors:sels methods:m
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2165
    "set some inst vars. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2166
     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
  2167
     and no change record written here; 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2168
     Do NOT use it."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2169
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2170
    selectorArray := sels.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2171
    methodArray := m.
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2174
setSuperclass:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2175
    "set the superclass of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2176
     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
  2177
     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
  2178
     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
  2179
     be correct, since no caches are flushed.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2180
     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
  2181
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2182
    SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2183
    superclass := aClass
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2186
setSuperclass:sup selectors:sels methods:m instSize:i flags:f
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2187
    "set some inst vars. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2188
     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
  2189
     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
  2190
     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
  2191
     be correct, since no caches are flushed.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2192
     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
  2193
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2194
    SubclassInfo := nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2195
    superclass := sup.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2196
    selectorArray := sels.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2197
    methodArray := m.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2198
    instSize := i.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2199
    flags := f
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2202
!Behavior methodsFor:'queries'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2203
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2204
allClassVarNames
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2205
    "return a collection of all the class variable name-strings
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2206
     this includes all superclass-class variables.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2207
     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
  2208
     here. Redefined in ClassDescription."
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2213
allDerivedInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2214
    "return a collection of all instances of myself and 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2215
     instances of all subclasses of myself.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2216
     This method is going to be removed for protocol compatibility with
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2217
     other STs; use allSubInstances"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2218
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2219
    self obsoleteMethodWarning:'please use #allSubInstances'.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2220
    ^ self allSubInstances
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2223
allInstVarNames
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2224
    "return a collection of all the instance variable name-strings
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2225
     this includes all superclass-instance variables.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2226
     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
  2227
     here. Redefined in ClassDescription."
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2232
allInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2233
    "return a collection of all my instances"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2234
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2235
    "Read the documentation on why there seem to be no
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2236
     instances of SmallInteger and UndefinedObject"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2237
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2238
    |coll|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2239
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2240
    coll := OrderedCollection new:100.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2241
    self allInstancesDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2242
	coll add:anObject
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2243
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2244
    ^ coll 
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
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2247
     ScrollBar allInstances
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2251
allSubInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2252
    "return a collection of all instances of myself and 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2253
     instances of all subclasses of myself."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2254
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2255
    |coll|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2256
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2257
    coll := OrderedCollection new:100.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2258
    self allSubInstancesDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2259
	(anObject isKindOf:self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2260
	    coll add:anObject
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
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2263
    ^ coll 
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
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2266
     View allSubInstances
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2270
allSubclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2271
    "return a collection of all subclasses (direct AND indirect) of
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2272
     the receiver. There will be no specific order, in which entries
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2273
     are returned."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2274
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2275
    |newColl|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2276
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2277
    newColl := OrderedCollection new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2278
    self allSubclassesDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2279
	newColl add:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2280
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2281
    ^ newColl
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
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2284
     Collection allSubclasses
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2288
allSubclassesInOrder
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2289
    "return a collection of all subclasses (direct AND indirect) of
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2290
     the receiver. Higher level subclasses will come before lower ones."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2291
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2292
    |newColl|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2293
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2294
    newColl := OrderedCollection new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2295
    self allSubclassesInOrderDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2296
	newColl add:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2297
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2298
    ^ newColl
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
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2301
     Collection allSubclassesInOrder
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2305
allSuperclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2306
    "return a collection of the receivers accumulated superclasses"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2307
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2308
    |aCollection theSuperClass|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2309
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2310
    theSuperClass := superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2311
    theSuperClass notNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2312
	aCollection := OrderedCollection new.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2313
	[theSuperClass notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2314
	    aCollection add:theSuperClass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2315
	    theSuperClass := theSuperClass superclass
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
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2318
    ^ aCollection
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
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2321
     String allSuperclasses 
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2325
cachedLookupMethodFor:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2326
    "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
  2327
     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
  2328
     and all of its superclasses are searched for aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2329
     Return the method, or nil if instances do not understand aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2330
     This interface provides exactly the same information as #lookupMethodFor:,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2331
     but uses the lookup-cache in the VM for faster search. 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2332
     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
  2333
     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
  2334
     irrelevant entries. (do NOT loop over all objects calling this method).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2335
     Does NOT (currently) handle MI"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2336
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2337
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2338
    extern OBJ __lookup();
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
    RETURN ( __lookup(self, aSelector, SENDER) );
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2341
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2342
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
     String cachedLookupMethodFor:#=
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2345
     String cachedLookupMethodFor:#asOrderedCollection
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2346
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2347
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2348
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2349
canBeSubclassed
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2350
    "return true, if its allowed to create subclasses of the receiver.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2351
     This method is redefined in SmallInteger and UndefinedObject, since
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2352
     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
  2353
     a class entry (you dont have to understand this :-)"
10
claus
parents: 5
diff changeset
  2354
claus
parents: 5
diff changeset
  2355
    ^ true
claus
parents: 5
diff changeset
  2356
!
claus
parents: 5
diff changeset
  2357
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2358
canUnderstand:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2359
    "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
  2360
     (i.e. true if my instances understand aSelector)"
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
    ^ (self lookupMethodFor:aSelector) notNil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2363
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2364
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2365
     True canUnderstand:#ifTrue:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2366
     True canUnderstand:#==
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2367
     True canUnderstand:#do:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2368
    "
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2369
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2370
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2371
compiledMethodAt:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2372
    "return the method for given selector aSelector or nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2373
     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
  2374
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2375
    |index|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2376
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2377
    selectorArray isNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2378
	('oops: nil selectorArray in ' , self name) errorPrintNL.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2379
	^ nil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2380
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2381
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2382
    index := selectorArray identityIndexOf:aSelector startingAt:1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2383
    (index == 0) ifTrue:[^ nil].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2384
    ^ methodArray at:index
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2385
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2386
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2387
     Object compiledMethodAt:#==
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2388
     (Object compiledMethodAt:#==) category
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2389
    "
620
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2392
containsMethod:aMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2393
    "Return true, if the argument, aMethod is a method of myself"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2394
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2395
    methodArray isNil ifTrue:[^ false].  "degenerated class"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2396
    ^ (methodArray identityIndexOf:aMethod startingAt:1) ~~ 0
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2399
derivedInstanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2400
    "return the number of instances of myself and of subclasses"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2401
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2402
    |count|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2403
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2404
    count := 0.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2405
    ObjectMemory allObjectsDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2406
	(anObject isKindOf:self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2407
	    count := count + 1
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
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2410
    ^ count
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2411
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2412
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2413
     View derivedInstanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2414
     SequenceableCollection derivedInstanceCount
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2415
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2416
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2417
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2418
hasInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2419
    "return true, if there are any instances of myself"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2420
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2421
    "Read the documentation on why there seem to be no
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2422
     instances of SmallInteger and UndefinedObject"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2423
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2424
"/    ObjectMemory allObjectsDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2425
"/        (anObject class == self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2426
"/            ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2427
"/        ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2428
"/    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2429
    ObjectMemory allInstancesOf:self do:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2430
	    ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2431
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2432
    ^ false
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2433
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
     Object hasInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2436
     SequenceableCollection hasInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2437
     Float hasInstances
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2438
     SmallInteger hasInstances
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2439
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2440
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2441
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2442
hasMethods
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2443
    "return true, if there are any (local) methods in this class"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2444
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2445
    ^ (methodArray size ~~ 0)
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2446
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  2447
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2448
     True hasMethods
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2449
     True class hasMethods
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2450
    "
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2453
hasMultipleSuperclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2454
    "Return true, if this class inherits from other classes 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2455
     (beside its primary superclass). 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2456
     This method is a preparation for a future multiple inheritance extension 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2457
     - currently it is not supported by the VM"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2458
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2459
    ^ otherSuperclasses notNil
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
implements:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2463
    "return true, if the receiver implements aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2464
     (i.e. implemented in THIS class - NOT in a superclass).
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2465
     Dont use this method to check if someone responds to a message -
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2466
     use #canUnderstand: on the class or #respondsTo: on the instance
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2467
     to do this."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2468
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2469
    ^ (selectorArray identityIndexOf:aSelector startingAt:1) ~~ 0
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
     True implements:#ifTrue:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2473
     True implements:#==
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2474
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2475
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2476
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2477
includesSelector:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2478
    "for ST-80 compatibility"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2479
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2480
    ^ self implements:aSelector
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2483
inheritsFrom:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2484
    "return true, if the receiver inherits methods from aClass"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2485
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2486
    ^ self isSubclassOf:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2487
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2488
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2489
     True inheritsFrom:Object
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2490
     LinkedList inheritsFrom:Array
356
claus
parents: 345
diff changeset
  2491
    "
357
claus
parents: 356
diff changeset
  2492
!
claus
parents: 356
diff changeset
  2493
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2494
instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2495
    "return the number of instances of myself."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2496
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2497
    "Read the documentation on why there seem to be no
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2498
     instances of SmallInteger and UndefinedObject"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2499
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2500
    |count|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2501
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2502
    count := 0.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2503
"/    ObjectMemory allObjectsDo:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2504
"/        (anObject class == self) ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2505
"/            count := count + 1
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2506
"/        ]
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2507
"/    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2508
    ObjectMemory allInstancesOf:self do:[:anObject |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2509
	count := count + 1
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2510
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2511
    ^ count
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2512
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2513
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2514
     View instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2515
     Object instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2516
     Float instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2517
     SequenceableCollection instanceCount
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2518
     SmallInteger instanceCount   .... mhmh - hear, hear
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2519
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2520
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2521
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2522
isBehavior
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2523
    "return true, if the receiver is describing another objects behavior,
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2524
     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
  2525
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2526
    ^ true
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2527
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2528
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2529
     True isBehavior   
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2530
     true isBehavior
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2531
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2532
!
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
isBits
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2535
    "return true, if instances have indexed byte or short instance variables.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2536
     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
  2537
     not prepared to handle them correctly."
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  2538
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  2539
%{  /* NOCONTEXT */
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2540
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2541
    REGISTER int what;
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2542
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2543
    what = (INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK);
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2544
    RETURN (( (what == __MASKSMALLINT(BYTEARRAY))
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2545
	     || (what == __MASKSMALLINT(WORDARRAY))) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2546
%}
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2549
isBytes
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2550
    "return true, if instances have indexed byte instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2551
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2552
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2553
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagBytes
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
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2556
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2557
    RETURN ( (((INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(BYTEARRAY)) ? true : false ); 
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2558
%}
620
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2561
isDoubles
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2562
    "return true, if instances have indexed double instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2563
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2564
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2565
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagDoubles
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2566
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2567
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2568
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2569
    RETURN ( (((INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(DOUBLEARRAY)) ? true : false ); 
620
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
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2572
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2573
isFixed
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2574
    "return true, if instances do not have indexed instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2575
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2576
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2577
	^ self isVariable not
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2578
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2579
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2580
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2581
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2582
    RETURN ( ((INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK)) ? false : true ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2583
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2584
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2585
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2586
isFloats
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2587
    "return true, if instances have indexed float instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2588
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2589
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2590
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagFloats
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2591
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2592
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2593
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2594
    RETURN ( (((INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(FLOATARRAY)) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2595
%}
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2596
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2597
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2598
isFloatsOrDoubles
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2599
    "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
  2600
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2601
%{  /* NOCONTEXT */
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2602
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2603
    int what;
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2604
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2605
    what = (INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK);
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2606
    RETURN (( (what == __MASKSMALLINT(FLOATARRAY))
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2607
	     || (what == __MASKSMALLINT(DOUBLEARRAY))) ? true : false ); 
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2608
%}
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2609
    "
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2610
     (Object new) class isFloatsOrDoubles 
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2611
     (Point new) class isFloatsOrDoubles   
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2612
     (Array new) class isFloatsOrDoubles   
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2613
     (ByteArray new) class isFloatsOrDoubles  
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2614
     (FloatArray new) class isFloatsOrDoubles  
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2615
     (DoubleArray new) class isFloatsOrDoubles  
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2616
    "
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2617
!
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2618
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2619
isLongs
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2620
    "return true, if instances have indexed long instance variables"
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
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2623
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagLongs
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
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2626
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2627
    RETURN ( (((INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(LONGARRAY)) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2628
%}
356
claus
parents: 345
diff changeset
  2629
!
claus
parents: 345
diff changeset
  2630
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2631
isPointers
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2632
    "return true, if instances have pointer instance variables 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2633
     i.e. are either non-indexed or have indexed pointer variables"
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
    "QUESTION: should we ignore WeakPointers ?"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2636
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2637
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2638
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2639
    REGISTER int flags;
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
    flags = _intVal(_INST(flags)) & ARRAYMASK;
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2642
    switch (flags) {
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2643
	default:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2644
	    /* normal objects */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2645
	    RETURN ( true );
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2646
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2647
	case BYTEARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2648
	case WORDARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2649
	case LONGARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2650
	case FLOATARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2651
	case DOUBLEARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2652
	    RETURN (false );
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2653
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2654
	case WKPOINTERARRAY:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2655
	    /* what about those ? */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2656
	    RETURN (true );
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2657
    }
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2658
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2659
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2660
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2661
isSubclassOf:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2662
    "return true, if I am a subclass of the argument, aClass"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2663
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2664
    |theClass|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2665
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2666
    theClass := superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2667
    [theClass notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2668
	(theClass == aClass) ifTrue:[^ true].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2669
%{
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2670
	if (__isBehaviorLike(theClass)) {
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2671
	    theClass = __ClassInstPtr(theClass)->c_superclass;
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2672
	} else {
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2673
	    theClass = nil;
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2674
	}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2675
%}.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2676
"/        theClass := theClass superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2677
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2678
    ^ false
356
claus
parents: 345
diff changeset
  2679
claus
parents: 345
diff changeset
  2680
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2681
     String isSubclassOf:Collection  
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2682
     LinkedList isSubclassOf:Array   
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2683
     1 isSubclassOf:Number              <- will fail since 1 is no class
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2684
    "     
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
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2687
isVariable
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2688
    "return true, if instances have indexed instance variables"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2689
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2690
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2691
	^ (flags bitAnd:(Behavior maskIndexType)) ~~ 0
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2692
     "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2693
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2694
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2695
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2696
    RETURN ( ((INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK)) ? true : false ); 
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2697
%}
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2698
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2699
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2700
isWords
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2701
    "return true, if instances have indexed short instance variables"
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
    "this could also be defined as:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2704
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagWords
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2705
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2706
%{  /* NOCONTEXT */
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2707
642
dbf407bedf64 slighly faster isXXX methods; added isFloatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  2708
    RETURN ( (((INT)(_INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(WORDARRAY)) ? true : false ); 
620
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
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2711
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2712
lookupMethodFor:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2713
    "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
  2714
     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
  2715
     and all of its superclasses are searched for aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2716
     Return the method, or nil if instances do not understand aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2717
     EXPERIMENTAL: take care of multiple superclasses."
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
    |m cls|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2720
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2721
    cls := self.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2722
    [cls notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2723
	m := cls compiledMethodAt:aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2724
	m notNil ifTrue:[^ m].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2725
	cls hasMultipleSuperclasses ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2726
	    cls superclasses do:[:aSuperClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2727
		m := aSuperClass lookupMethodFor:aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2728
		m notNil ifTrue:[^ m].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2729
	    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2730
	    ^ nil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2731
	] ifFalse:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2732
	    cls := cls superclass
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
    ^ nil
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2736
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2737
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2738
selectorAtMethod:aMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2739
    "Return the selector for given method aMethod."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2740
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2741
    ^ self selectorAtMethod:aMethod ifAbsent:[nil]
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
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2744
     |m|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2745
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2746
     m := Object compiledMethodAt:#copy.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2747
     Fraction selectorAtMethod:m.
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
    "
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2750
     |m|
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
     m := Object compiledMethodAt:#copy.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2753
     Object selectorAtMethod:m.
356
claus
parents: 345
diff changeset
  2754
    "
claus
parents: 345
diff changeset
  2755
!
claus
parents: 345
diff changeset
  2756
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2757
selectorAtMethod:aMethod ifAbsent:failBlock
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2758
    "return the selector for given method aMethod
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2759
     or the value of failBlock, if not found."
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
    |index|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2762
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2763
    index := methodArray identityIndexOf:aMethod startingAt:1.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2764
    (index == 0) ifTrue:[^ failBlock value].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2765
    ^ selectorArray at:index
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2766
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2767
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2768
     |m|
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
     m := Object compiledMethodAt:#copy.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2771
     Object selectorAtMethod:m ifAbsent:['oops'].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2772
    "
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2773
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2774
     |m|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2775
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2776
     m := Object compiledMethodAt:#copy.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2777
     Fraction selectorAtMethod:m ifAbsent:['oops'].
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2778
    "
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2779
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2780
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2781
selectorIndex:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2782
    "return the index in the arrays for given selector aSelector"
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
    ^ selectorArray identityIndexOf:aSelector startingAt:1
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2785
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2786
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2787
sizeOfInst:n
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2788
    "return the number of bytes required for an instance of
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2789
     myself with n indexed instance variables. The argument n 
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2790
     should be zero for classes without indexed instance variables.
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2791
     See Behavior>>niceNew: for an application of this."
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2792
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2793
    |nInstvars|
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2794
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2795
    nInstvars := self instSize.
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2796
%{
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2797
    int nBytes;
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2798
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2799
    nBytes = _intVal(nInstvars) * sizeof(OBJ) + OHDR_SIZE; 
249
claus
parents: 216
diff changeset
  2800
    if (__isSmallInteger(n)) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2801
	int nIndex;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2802
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2803
	nIndex = _intVal(n);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2804
	switch (_intVal(_INST(flags)) & ARRAYMASK) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2805
	    case BYTEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2806
		nBytes += nIndex;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2807
		if (nBytes & (ALIGN - 1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2808
		    nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2809
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2810
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2811
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2812
	    case WORDARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2813
		nBytes += nIndex * sizeof(short);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2814
		if (nBytes & (ALIGN - 1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2815
		    nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2816
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2817
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2818
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2819
	    case LONGARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2820
		nBytes += nIndex * sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2821
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2822
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2823
	    case FLOATARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2824
		nBytes += nIndex * sizeof(float);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2825
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2826
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2827
	    case DOUBLEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2828
		nBytes += nIndex * sizeof(double);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2829
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2830
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2831
	    default:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2832
		nBytes += nIndex * sizeof(OBJ);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2833
		break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2834
	}
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2835
    }
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2836
    RETURN (_MKSMALLINT(nBytes));
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2837
%}
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2838
!
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  2839
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2840
sourceCodeAt:aSelector
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2841
    "return the methods source for given selector aSelector or nil.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2842
     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
  2843
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2844
    |method|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2845
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2846
    method := self compiledMethodAt:aSelector.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2847
    method isNil ifTrue:[^ nil].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2848
    ^ method source
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2849
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2850
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2851
     True sourceCodeAt:#ifTrue:
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2852
     Object sourceCodeAt:#==
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2853
     Behavior sourceCodeAt:#sourceCodeAt:
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2854
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2855
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2856
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2857
subclasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2858
    "return a collection of the direct subclasses of the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2859
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2860
    |newColl|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2861
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2862
    SubclassInfo notNil ifTrue:[
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2863
	newColl := SubclassInfo at:self ifAbsent:nil.
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2864
	newColl notNil ifTrue:[^ newColl asOrderedCollection]
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2865
    ].
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2866
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2867
    newColl := OrderedCollection new.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2868
    self subclassesDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2869
	newColl add:aClass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2870
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2871
    ^ newColl
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2872
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2873
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2874
     Collection subclasses
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2875
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2876
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2877
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2878
superclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2879
    "return a collection of the receivers immediate superclasses.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2880
     This method is a preparation for a future multiple inheritance extension 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2881
     - currently it is not supported by the VM"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2882
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2883
    |a|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2884
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2885
    a := Array with:superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2886
    otherSuperclasses notNil ifTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2887
	^ a , otherSuperclasses
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2888
    ].
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2889
    ^ a
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2890
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2891
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2892
     String superclasses  
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2893
    "
2
claus
parents: 1
diff changeset
  2894
!
claus
parents: 1
diff changeset
  2895
claus
parents: 1
diff changeset
  2896
whichClassImplements:aSelector
328
claus
parents: 325
diff changeset
  2897
    "obsolete interface;
claus
parents: 325
diff changeset
  2898
     use whichClassIncludesSelector: for ST-80 compatibility."
claus
parents: 325
diff changeset
  2899
claus
parents: 325
diff changeset
  2900
    ^ self whichClassIncludesSelector:aSelector
claus
parents: 325
diff changeset
  2901
!
claus
parents: 325
diff changeset
  2902
claus
parents: 325
diff changeset
  2903
whichClassIncludesSelector:aSelector
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2904
    "return the class in the inheritance chain, which implements the method
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2905
     for aSelector; return nil if none.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2906
     EXPERIMENTAL: handle multiple superclasses"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2907
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2908
    |cls|
2
claus
parents: 1
diff changeset
  2909
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2910
    cls := self.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2911
    [cls notNil] whileTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2912
	(cls implements:aSelector) ifTrue:[^ cls].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2913
	cls hasMultipleSuperclasses ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2914
	    cls superclasses do:[:aSuperClass |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2915
		|implementingClass|
2
claus
parents: 1
diff changeset
  2916
328
claus
parents: 325
diff changeset
  2917
		implementingClass := aSuperClass whichClassIncludesSelector:aSelector.
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2918
		implementingClass notNil ifTrue:[^ implementingClass].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2919
	    ].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2920
	    ^ nil
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2921
	] ifFalse:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2922
	    cls := cls superclass
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2923
	]
2
claus
parents: 1
diff changeset
  2924
    ].
claus
parents: 1
diff changeset
  2925
    ^ nil
claus
parents: 1
diff changeset
  2926
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2927
    "
328
claus
parents: 325
diff changeset
  2928
     String whichClassIncludesSelector:#==
claus
parents: 325
diff changeset
  2929
     String whichClassIncludesSelector:#collect:
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2930
    "
2
claus
parents: 1
diff changeset
  2931
!
claus
parents: 1
diff changeset
  2932
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2933
withAllSubclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2934
    "return a collection containing the receiver and 
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2935
     all subclasses (direct AND indirect) of the receiver"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2936
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2937
    |newColl|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2938
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2939
    newColl := OrderedCollection with:self.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2940
    self allSubclassesDo:[:aClass |
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2941
	newColl add:aClass
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2942
    ].
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2943
    ^ newColl
328
claus
parents: 325
diff changeset
  2944
claus
parents: 325
diff changeset
  2945
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2946
     Collection withAllSubclasses
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2947
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2948
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2949
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2950
withAllSuperclasses
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2951
    "return a collection containing the receiver and all
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2952
     of the receivers accumulated superclasses"
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2953
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2954
    |aCollection theSuperClass|
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2955
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2956
    aCollection := OrderedCollection with:self.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2957
    theSuperClass := superclass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2958
    [theSuperClass notNil] whileTrue:[
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2959
	aCollection add:theSuperClass.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2960
	theSuperClass := theSuperClass superclass
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2961
    ].
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2962
    ^ aCollection
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2963
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2964
    "
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2965
     String withAllSuperclasses 
308
f04744ef7b5d *** empty log message ***
claus
parents: 295
diff changeset
  2966
    "
2
claus
parents: 1
diff changeset
  2967
! !
620
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2968
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2969
!Behavior methodsFor:'snapshots'!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2970
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2971
postSnapshot
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2972
    "sent by ObjectMemory, after a snapshot has been written.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2973
     Nothing done here."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2974
!
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2975
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2976
preSnapshot
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2977
    "sent by ObjectMemory, before a snapshot is written.
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2978
     Nothing done here."
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2979
! !
c7353f86a302 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2980
662
df7953db3847 version method at the end
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
  2981
!Behavior class methodsFor:'documentation'!
df7953db3847 version method at the end
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
  2982
df7953db3847 version method at the end
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
  2983
version
759
908363ce8a32 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
  2984
    ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.58 1995-12-15 12:47:17 cg Exp $'
662
df7953db3847 version method at the end
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
  2985
! !