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