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