Behavior.st
author claus
Mon, 10 Oct 1994 01:20:00 +0100
changeset 154 d4236ec280a6
parent 151 07c448be12b6
child 165 63341654cfb8
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 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
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    14
       instanceVariableNames:'superclass otherSuperclasses
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    15
			      selectorArray methodArray
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    16
			      instSize flags'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    17
       classVariableNames:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
       poolDictionaries:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
       category:'Kernel-Classes'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
a27a279701f8 Initial revision
claus
parents:
diff changeset
    22
Behavior comment:'
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
    23
COPYRIGHT (c) 1988 by Claus Gittinger
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    24
	      All Rights Reserved
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
    25
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    26
$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.21 1994-10-10 00:19:49 claus Exp $
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    27
'!
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    28
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    29
!Behavior class methodsFor:'documentation'!
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    30
88
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    31
copyright
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    32
"
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    33
 COPYRIGHT (c) 1988 by Claus Gittinger
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    34
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    35
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    36
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    37
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    38
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    39
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    40
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    41
 hereby transferred.
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
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    45
version
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    46
"
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    47
$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.21 1994-10-10 00:19:49 claus Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    48
"
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    49
!
81dacba7a63a *** empty log message ***
claus
parents: 82
diff changeset
    50
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    51
documentation
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    52
"
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    53
    Every class in the system inherits from Behavior (via Class, ClassDescription);
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    54
    so here is where most of the class messages end up being implemented.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    55
    (to answer a FAQ: 'Point basicNew' will be done here :-)
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    56
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
    57
    Beginners should keep in mind, that all classes are instances of subclasses
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
    58
    of Behavior, therefore you will find the above mentioned 'basicNew:' method 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
    59
    under the 'instance'-methods of Behavior - NOT under the class methods 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    60
    ('Behavior new' will create and return a new class, while sending 'new' to 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    61
    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
    62
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    63
    Behavior provides minimum support for all classes - additional stuff is
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
    64
    found in ClassDescription and Class. Behaviors provides all mechanisms needed
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
    65
    to create instances, and send messages to those. However, Behavior does not provide 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
    66
    all the (symbolic) information needed to compile methods for a class or to get
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
    67
    useful information in inspectors.
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    68
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    69
    In contrast to other ST implementations, the methods have been separated
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    70
    from the selectors (there is no Dictionary, but two separate Arrays)
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    71
    - this avoids the need for knowledge about Dictionaries in the runtime library (VM)
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    72
    (lookup and search in these is seldom anyway, so the added benefit from using a 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    73
     hashed dictionary is almost void).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    75
    Instance variables:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    77
	superclass        <Class>           the receivers superclass
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    78
	otherSuperclasses <Array of Class>  experimental: other superclasses
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    79
	selectorArray     <Array of Symbol> the selectors for which inst-methods are defined here
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    80
	methodArray       <Array of Method> the inst-methods corresponding to the selectors
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    81
	instSize          <SmallInteger>    the number of instance variables
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
    82
	flags             <SmallInteger>    special flag bits coded in a number
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
    84
    flag bits (see stc.h):
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    85
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
    86
    NOTICE: layout known by compiler and runtime system; be careful when changing
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    87
"
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
    88
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    90
!Behavior class methodsFor:'queries'!
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    91
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    92
isBuiltInClass
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    93
    "this class is known by the run-time-system"
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    94
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    95
    ^ true
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    96
! !
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    97
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    98
!Behavior class methodsFor:'creating new classes'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    99
a27a279701f8 Initial revision
claus
parents:
diff changeset
   100
new
a27a279701f8 Initial revision
claus
parents:
diff changeset
   101
    "creates and return a new class"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
    |newClass|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   104
a27a279701f8 Initial revision
claus
parents:
diff changeset
   105
    newClass := self basicNew.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   106
    newClass setSuperclass:Object
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   107
		 selectors:(Array new:0)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   108
		   methods:(Array new:0)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   109
		  instSize:0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   110
		     flags:0.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   111
    ^ newClass
a27a279701f8 Initial revision
claus
parents:
diff changeset
   112
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
!Behavior methodsFor:'initialization'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   115
a27a279701f8 Initial revision
claus
parents:
diff changeset
   116
initialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
    "to catch initialize for classes which do not"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   121
a27a279701f8 Initial revision
claus
parents:
diff changeset
   122
reinitialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
    "to catch reinitialize for classes which do not"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   126
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   127
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   128
!Behavior methodsFor:'copying'!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   129
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   130
deepCopy
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   131
    "return a deep copy of the receiver
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   132
     - return the receiver here - time will show if this is ok"
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   133
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   134
    ^ self
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   135
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   136
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   137
deepCopyUsing:aDictionary
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   138
    "return a deep copy of the receiver
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   139
     - return the receiver here - time will show if this is ok"
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   140
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   141
    ^ self
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   142
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   143
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   144
simpleDeepCopy
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   145
    "return a deep copy of the receiver
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   146
     - return the receiver here - time will show if this is ok"
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   147
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   148
    ^ self
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   149
! !
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   150
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   151
!Behavior methodsFor:'creating an instance of myself'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
a27a279701f8 Initial revision
claus
parents:
diff changeset
   153
uninitializedNew
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   154
    "same as new - only redefined in ByteArray"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   155
a27a279701f8 Initial revision
claus
parents:
diff changeset
   156
    ^ self basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
uninitializedNew:anInteger
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   160
    "same as new:anInteger - only redefined in ByteArray"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   161
a27a279701f8 Initial revision
claus
parents:
diff changeset
   162
    ^ self basicNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   163
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   164
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   165
niceBasicNew:anInteger
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   166
    "same as basicNew:anInteger, but tries to avoid long pauses
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   167
     due to garbage collection. This method checks to see if
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   168
     allocation is possible without a pause, and does a background
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   169
     incremental garbage collect first if there is not enough memory
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   170
     available at the moment for fast allocation. 
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   171
     This is useful in low-priority background processes which like to 
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   172
     avoid disturbing any higher priority foreground process while allocating
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   173
     big amounts of memory. Of course, using this method only makes
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   174
     sense for big or huge objects (say > 200k).
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   175
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   176
     EXPERIMENTAL: this is a non-standard interface and should only 
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   177
     be used for special applications. There is no guarantee, that this
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   178
     method will be available in future ST/X releases."
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   179
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   180
    |size|
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   181
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   182
    size := self sizeOfInst:anInteger.
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   183
    (ObjectMemory checkForFastNew:size) ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   184
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   185
	 incrementally collect garbage
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   186
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   187
	ObjectMemory incrementalGC.
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   188
    ].
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   189
    ^ self basicNew:anInteger
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   190
!
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   191
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   192
new
a27a279701f8 Initial revision
claus
parents:
diff changeset
   193
    "return an instance of myself without indexed variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   194
a27a279701f8 Initial revision
claus
parents:
diff changeset
   195
    ^ self basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
   196
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   197
a27a279701f8 Initial revision
claus
parents:
diff changeset
   198
new:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   199
    "return an instance of myself with anInteger indexed variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
    ^ self basicNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   202
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   203
a27a279701f8 Initial revision
claus
parents:
diff changeset
   204
basicNew
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   205
    "return an instance of myself without indexed variables.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   206
     If the receiver-class has indexed instvars, the new object will have
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   207
     a basicSize of zero - 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   208
     i.e. 'aClass basicNew' is equivalent to 'aClass basicNew:0'.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   209
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   210
     ** Do not redefine this method in any class **"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   211
a27a279701f8 Initial revision
claus
parents:
diff changeset
   212
%{  /* NOCONTEXT */
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   213
    OBJ new();
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   214
    REGISTER OBJ newobj;
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   215
    REGISTER char *nextPtr;
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   216
    unsigned int instsize;
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   217
    REGISTER unsigned int nInstVars;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   218
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   219
    /*
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   220
     * the following ugly code is nothing more than a new() followed
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   221
     * by a nilling of the new instance.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   222
     * Unrolled for a bit more speed since this is one of the central object 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   223
     * allocation methods in the system
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   224
     */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   225
    nInstVars = _intVal(_INST(instSize));
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   226
    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   227
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   228
    newobj = (OBJ) newNextPtr;
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   229
    nextPtr = ((char *)newobj) + instsize;
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   230
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   231
    /*
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   232
     * dont argue about the goto and the arrangement below - it saves 
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   233
     * an extra nil-compare and branch in the common case ...
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   234
     * (i.e. if no GC is needed, we fall through without a branch)
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   235
     */
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   236
    if (nextPtr < newEndPtr) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   237
	_objPtr(newobj)->o_size = instsize;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   238
	/* o_allFlags(newobj) = 0;              */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   239
	/* _objPtr(newobj)->o_space = newSpace; */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   240
	o_setAllFlags(newobj, newSpace);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   241
#ifdef ALIGN4
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   242
	newNextPtr = nextPtr;
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   243
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   244
	if (instsize & (ALIGN-1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   245
	    newNextPtr = (char *)newobj + (instsize & ~(ALIGN-1)) + ALIGN;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   246
	} else {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   247
	    newNextPtr = nextPtr;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   248
	}
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   249
#endif
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   250
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   251
ok:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   252
	_InstPtr(newobj)->o_class = self;
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   253
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   254
	if (nInstVars) {
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   255
#if defined(FAST_OBJECT_MEMSET4)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   256
	    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   257
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   258
	    REGISTER OBJ *op;
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   259
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   260
	    op = _InstPtr(newobj)->i_instvars;
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   261
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   262
# if !defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   263
	    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   264
	     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   265
	     */
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   266
#  if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   267
	    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   268
		*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   269
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   270
		while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   271
		    *(double *)op = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   272
		    ((double *)op)[1] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   273
		    ((double *)op)[2] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   274
		    ((double *)op)[3] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   275
		    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   276
		    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   277
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   278
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   279
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   280
		*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   281
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   282
	    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   283
#  else
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   284
#   if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   285
	    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   286
		*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   287
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   288
		while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   289
		    *(long long *)op = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   290
		    ((long long *)op)[1] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   291
		    ((long long *)op)[2] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   292
		    ((long long *)op)[3] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   293
		    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   294
		    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   295
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   296
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   297
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   298
		*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   299
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   300
	    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   301
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   302
#   else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   303
#    if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   304
	    while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   305
		*op = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   306
		*(op+1) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   307
		*(op+2) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   308
		*(op+3) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   309
		*(op+4) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   310
		*(op+5) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   311
		*(op+6) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   312
		*(op+7) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   313
		op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   314
		nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   315
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   316
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   317
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   318
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   319
	    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   320
#    else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   321
#     if defined(FAST_MEMSET)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   322
	    memset(_InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   323
#     else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   324
	    do {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   325
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   326
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   327
	    } while (nInstVars != 0);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   328
#     endif
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   329
#    endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   330
#   endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   331
#  endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   332
# else /* nil could be ~~ 0 */
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   333
	    while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   334
		*op = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   335
		*(op+1) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   336
		*(op+2) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   337
		*(op+3) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   338
		*(op+4) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   339
		*(op+5) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   340
		*(op+6) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   341
		*(op+7) = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   342
		op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   343
		nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   344
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   345
	    while (nInstVars != 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   346
		*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   347
		nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   348
	    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   349
# endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   350
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   351
	}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   352
	RETURN ( newobj );
81
e02c66a7296f *** empty log message ***
claus
parents: 77
diff changeset
   353
    }
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   354
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   355
    /*
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   356
     * the slow case - a GC will occur
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   357
     */
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   358
    PROTECT_CONTEXT
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   359
    newobj = new(instsize, SENDER);
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   360
    UNPROTECT_CONTEXT
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   361
    if (newobj != nil) goto ok;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   362
%}
2
claus
parents: 1
diff changeset
   363
.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   364
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   365
     memory allocation failed.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   366
     When we arrive here, there was no memory, even after
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   367
     a garbage collect. This means, that the VM wanted to
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   368
     get some more memory from the Operatingsystem, which
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   369
     was not kind enough to give some
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   370
    "
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   371
    ^ ObjectMemory allocationFailureSignal raise.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   372
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   373
a27a279701f8 Initial revision
claus
parents:
diff changeset
   374
basicNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   375
    "return an instance of myself with anInteger indexed variables.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   376
     If the receiver-class has no indexed instvars, this is only allowed
a27a279701f8 Initial revision
claus
parents:
diff changeset
   377
     if the argument, anInteger is zero.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   378
     ** Do not redefine this method in any class **"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   379
a27a279701f8 Initial revision
claus
parents:
diff changeset
   380
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   381
a27a279701f8 Initial revision
claus
parents:
diff changeset
   382
    OBJ newobj;
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   383
    unsigned INT instsize, nInstVars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   384
    INT nindexedinstvars;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   385
    unsigned INT flags;
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   386
#if ! defined(FAST_ARRAY_MEMSET) || defined(NEGATIVE_ADDRESSES)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   387
    REGISTER char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   388
    short *sp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   389
    long *lp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   390
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   391
    REGISTER OBJ *op;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   392
    float *fp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   393
    double *dp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   394
    extern OBJ new();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   395
a27a279701f8 Initial revision
claus
parents:
diff changeset
   396
    if (_isSmallInteger(anInteger)) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   397
	nindexedinstvars = _intVal(anInteger);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   398
	if (nindexedinstvars >= 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   399
	    nInstVars = _intVal(_INST(instSize));
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   400
	    flags = _intVal(_INST(flags)) & ARRAYMASK;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   401
	    switch (flags) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   402
		case BYTEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   403
		    instsize = OHDR_SIZE + nindexedinstvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   404
		    if (nInstVars == 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   405
			if (_CanDoQuickNew(instsize)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   406
			    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   407
			     * the most common case
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   408
			     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   409
			    _qCheckedNew(newobj, instsize);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   410
			    _InstPtr(newobj)->o_class = self;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   411
#if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   412
			    memset(_InstPtr(newobj)->i_instvars, 0, nindexedinstvars);
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   413
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   414
			    cp = (char *)_InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   415
			    while (nindexedinstvars >= sizeof(long)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   416
				*(long *)cp = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   417
				cp += sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   418
				nindexedinstvars -= sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   419
			    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   420
			    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   421
				*cp++ = '\0';
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   422
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   423
			    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   424
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   425
		    } else {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   426
			instsize += __OBJS2BYTES__(nInstVars);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   427
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   428
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   429
		    _qNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   430
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   431
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   432
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   433
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   434
		    _InstPtr(newobj)->o_class = self;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   435
#if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   436
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   437
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   438
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   439
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   440
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   441
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   442
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   443
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   444
		    cp = (char *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   445
		    while (nindexedinstvars >= sizeof(long)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   446
			*(long *)cp = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   447
			cp += sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   448
			nindexedinstvars -= sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   449
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   450
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   451
			*cp++ = '\0';
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   452
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   453
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   454
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   455
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   456
		case WORDARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   457
		    instsize = OHDR_SIZE + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   458
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   459
			       nindexedinstvars * sizeof(short);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   460
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   461
		    _qNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   462
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   463
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   464
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   465
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   466
		    _InstPtr(newobj)->o_class = self;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   467
#if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   468
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   469
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   470
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   471
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   472
#else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   473
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   474
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   475
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   476
		    sp = (short *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   477
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   478
			*sp++ = 0;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   479
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   480
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   481
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   482
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   483
	       case LONGARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   484
		    instsize = OHDR_SIZE + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   485
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   486
			       nindexedinstvars * sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   487
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   488
		    _qAlignedNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   489
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   490
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   491
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   492
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   493
		    _InstPtr(newobj)->o_class = self;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   494
#if defined(FAST_ARRAY_MEMSET4) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   495
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   496
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   497
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   498
		    memset4(_InstPtr(newobj)->i_instvars, 0, nInstVars + nindexedinstvars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   499
#else
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   500
# if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   501
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   502
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   503
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   504
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   505
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   506
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   507
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   508
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   509
		    lp = (long *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   510
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   511
			*lp++ = 0;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   512
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   513
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   514
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   515
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   516
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   517
	       case FLOATARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   518
		    instsize = sizeof(struct floatArray) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   519
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   520
			       (nindexedinstvars - 1) * sizeof(float);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   521
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   522
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   523
		    _qNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   524
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   525
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   526
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   527
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   528
		    _InstPtr(newobj)->o_class = self;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   529
		    op = _InstPtr(newobj)->i_instvars;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   530
# if defined(mips) /* knowin that float 0.0 is all-zeros */
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   531
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   532
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   533
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   534
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   535
		    fp = (float *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   536
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   537
			*fp++ = 0.0;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   538
# endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   539
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   540
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   541
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   542
	       case DOUBLEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   543
		    instsize = sizeof(struct doubleArray) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   544
			       __OBJS2BYTES__(nInstVars) + 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   545
			       (nindexedinstvars - 1) * sizeof(double);
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   546
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   547
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   548
		    _qAlignedNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   549
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   550
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   551
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   552
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   553
		    _InstPtr(newobj)->o_class = self;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   554
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   555
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   556
			*op++ = nil;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   557
#ifdef NEED_DOUBLE_ALIGN
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   558
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   559
		     * care for double alignment
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   560
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   561
		    if ((INT)op & (ALIGN-1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   562
			*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   563
		    }
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 47
diff changeset
   564
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   565
		    dp = (double *)op;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   566
		    while (nindexedinstvars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   567
			*dp++ = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   568
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   569
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   570
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   571
		case WKPOINTERARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   572
		case POINTERARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   573
		    nInstVars += nindexedinstvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   574
		    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   575
		    PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   576
		    _qAlignedNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   577
		    UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   578
		    if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   579
			break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   580
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   581
		    _InstPtr(newobj)->o_class = self;
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   582
#if defined(FAST_ARRAY_MEMSET4)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   583
		    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   584
#else
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   585
# if !defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   586
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   587
		     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   588
		     */
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   589
#ifdef mips
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   590
# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   591
# undef FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   592
# undef FAST_ARRAY_MEMSET_LONGLONG_UNROLLED
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   593
# define FAST_ARRAY_MEMSET
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   594
#endif
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   595
#ifdef sparc
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   596
# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   597
#endif
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   598
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   599
#  if defined(FAST_ARRAY_MEMSET_DOUBLES_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   600
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   601
		    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   602
			*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   603
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   604
			while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   605
			    *(double *)op = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   606
			    ((double *)op)[1] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   607
			    ((double *)op)[2] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   608
			    ((double *)op)[3] = 0.0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   609
			    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   610
			    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   611
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   612
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   613
		    while (nInstVars) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   614
			*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   615
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   616
		    }
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   617
#  else
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   618
#   if defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   619
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   620
		    if (nInstVars > 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   621
			*op++ = nil;    /* for alignment */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   622
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   623
			while (nInstVars >= 8) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   624
			    *(long long *)op = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   625
			    ((long long *)op)[1] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   626
			    ((long long *)op)[2] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   627
			    ((long long *)op)[3] = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   628
			    op += 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   629
			    nInstVars -= 8;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   630
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   631
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   632
		    while (nInstVars) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   633
			*op++ = 0;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   634
			nInstVars--;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   635
		    }
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   636
#   else
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   637
#    if defined(FAST_ARRAY_MEMSET)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   638
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   639
#    else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   640
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   641
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   642
			*op++ = nil;
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   643
#    endif
82
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   644
#   endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   645
#  endif
0147b4f725ae *** empty log message ***
claus
parents: 81
diff changeset
   646
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   647
		    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   648
		    while (nInstVars--)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   649
			*op++ = nil;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   650
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   651
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   652
		    RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   653
		    break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   654
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   655
		default:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   656
		    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   657
		     * new:n for non-variable classes only allowed if
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   658
		     * n == 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   659
		     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   660
		    if (nindexedinstvars == 0) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   661
			instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   662
			PROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   663
			_qAlignedNew(newobj, instsize, SENDER);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   664
			UNPROTECT_CONTEXT
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   665
			if (newobj == nil) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   666
			    break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   667
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   668
			_InstPtr(newobj)->o_class = self;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   669
			if (nInstVars) {
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   670
#if defined(FAST_OBJECT_MEMSET4)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   671
			    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   672
#else
a27a279701f8 Initial revision
claus
parents:
diff changeset
   673
# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   674
			    /*
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   675
			     * knowing that nil is 0
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   676
			     */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   677
			    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   678
# else
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   679
			    op = _InstPtr(newobj)->i_instvars;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   680
			    do {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   681
				*op++ = nil;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   682
			    } while (--nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   683
# endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   684
#endif
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   685
			}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   686
			RETURN ( newobj );
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   687
		    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   688
		    break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   689
	    }
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   690
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   691
    }
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   692
%}.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   693
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   694
     arrive here if something went wrong ...
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   695
     figure out what it was
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   696
    "
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   697
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   698
    (anInteger isMemberOf:SmallInteger) ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   699
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   700
	 the argument is either not an integer,
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   701
	 or a LargeInteger (which means that its definitely too big)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   702
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   703
	self error:'argument to new: must be Integer'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   704
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   705
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   706
    (anInteger < 0) ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   707
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   708
	 the argument is negative,
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   709
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   710
	self error:'bad (negative) argument to new:'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   711
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   712
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   713
    self isVariable ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   714
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   715
	 this class does not have any indexed instance variables
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   716
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   717
	self error:'class has no indexed instvars - cannot create with new:'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   718
	^ nil
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   719
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   720
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   721
     memory allocation failed.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   722
     When we arrive here, there was no memory, even after
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   723
     a garbage collect. This means, that the VM wanted to
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   724
     get some more memory from the Operatingsystem, which
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   725
     was not kind enough to give some
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   726
    "
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
   727
    ^ ObjectMemory allocationFailureSignal raise.
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   728
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   729
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   730
readFrom:aStream
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
   731
    "read an objects printed representation from the argument, aStream 
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
   732
     and return it. 
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   733
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   734
     The read object must be a kind of myself if its not, an error is raised.
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
   735
     - to get any object, use 'Object readFrom:...',
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
   736
       to get any number, use 'Number readFrom:...' and so on.
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   737
     This is the reverse operation to 'storeOn:'.
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
   738
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   739
     WARNING: storeOn: does not handle circular references and multiple 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   740
	      references to the same object - use #storeBinary: for this."
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   741
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   742
    |newObject|
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   743
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   744
    newObject := self compiler evaluate:aStream.
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   745
    (newObject isKindOf:self) ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   746
	self error:('expected ' , self name)
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   747
    ].
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   748
    ^ newObject
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   749
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   750
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   751
     |s|
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   752
     s := WriteStream on:String new.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   753
     #(1 2 3 4) storeOn:s.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   754
     Object readFrom:(ReadStream on:s contents)  
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   755
    "
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   756
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   757
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   758
readFromString:aString
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   759
    "create an object from its printed representation
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   760
     (i.e. recreate what was stored using storeOn: or storeString).
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   761
     See warning in Behavior>>readFrom:"
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   762
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
   763
    ^ self readFrom:(ReadStream on:aString)
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   764
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   765
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   766
     Integer readFromString:'12345678901234567890' 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   767
     Point readFromString:'1@2'  
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   768
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   769
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   770
10
claus
parents: 5
diff changeset
   771
!Behavior methodsFor:'autoload check'!
claus
parents: 5
diff changeset
   772
claus
parents: 5
diff changeset
   773
isLoaded
claus
parents: 5
diff changeset
   774
    "return true, if the class has been loaded; 
claus
parents: 5
diff changeset
   775
     redefined in Autoload; see comment there"
claus
parents: 5
diff changeset
   776
claus
parents: 5
diff changeset
   777
    ^ true
claus
parents: 5
diff changeset
   778
!
claus
parents: 5
diff changeset
   779
claus
parents: 5
diff changeset
   780
autoload
claus
parents: 5
diff changeset
   781
    "force autoloading - do nothing here; 
claus
parents: 5
diff changeset
   782
     redefined in Autoload; see comment there"
claus
parents: 5
diff changeset
   783
claus
parents: 5
diff changeset
   784
    ^ self
claus
parents: 5
diff changeset
   785
! !
claus
parents: 5
diff changeset
   786
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   787
!Behavior methodsFor:'snapshots'!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   788
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   789
preSnapshot
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   790
    "sent by ObjectMemory, before a snapshot is written.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   791
     Nothing done here."
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   792
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   793
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   794
postSnapshot
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   795
    "sent by ObjectMemory, after a snapshot has been written.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   796
     Nothing done here."
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   797
! !
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   798
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   799
!Behavior class methodsFor:'flag bit constants'!
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   800
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   801
flagNotIndexed
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   802
    "return the flag code for non-indexed instances"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   803
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   804
    ^ 0
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   805
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   806
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   807
flagBytes
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   808
    "return the flag code for byte-valued indexed instances"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   809
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   810
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   811
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   812
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   813
    RETURN ( _MKSMALLINT(BYTEARRAY) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   814
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   815
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   816
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   817
flagWords
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   818
    "return the flag code for word-valued indexed instances (i.e. 2-byte)"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   819
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   820
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   821
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   822
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   823
    RETURN ( _MKSMALLINT(WORDARRAY) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   824
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   825
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   826
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   827
flagLongs
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   828
    "return the flag code for long-valued indexed instances (i.e. 4-byte)"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   829
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   830
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   831
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   832
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   833
    RETURN ( _MKSMALLINT(LONGARRAY) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   834
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   835
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   836
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   837
flagFloats
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   838
    "return the flag code for float-valued indexed instances (i.e. 4-byte reals)"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   839
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   840
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   841
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   842
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   843
    RETURN ( _MKSMALLINT(FLOATARRAY) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   844
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   845
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   846
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   847
flagDoubles
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   848
    "return the flag code for double-valued indexed instances (i.e. 8-byte reals)"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   849
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   850
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   851
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   852
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   853
    RETURN ( _MKSMALLINT(DOUBLEARRAY) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   854
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   855
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   856
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   857
flagPointers
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   858
    "return the flag code for pointer indexed instances (i.e. Array of object)"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   859
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   860
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   861
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   862
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   863
    RETURN ( _MKSMALLINT(POINTERARRAY) );
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   864
%}
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   865
! 
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   866
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   867
flagWeakPointers
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   868
    "return the flag code for weak pointer indexed instances (i.e. WeakArray)"
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   869
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   870
%{  /* NOCONTEXT */
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   871
    /* this is defined as a primitive to get defines from stc.h */
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   872
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   873
    RETURN ( _MKSMALLINT(WKPOINTERARRAY) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   874
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   875
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   876
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   877
maskIndexType
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   878
    "return a mask to extract all index-type bits"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   879
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   880
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   881
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   882
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   883
    RETURN ( _MKSMALLINT(ARRAYMASK) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   884
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   885
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   886
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   887
flagBlock
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   888
    "return the flag code which marks Block-type instances"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   889
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   890
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   891
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   892
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   893
    RETURN ( _MKSMALLINT(BLOCK_INSTS) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   894
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   895
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   896
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   897
flagMethod
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   898
    "return the flag code which marks Method-type instances"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   899
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   900
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   901
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   902
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   903
    RETURN ( _MKSMALLINT(METHOD_INSTS) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   904
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   905
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   906
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   907
flagContext
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   908
    "return the flag code which marks Context-type instances"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   909
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   910
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   911
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   912
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   913
    RETURN ( _MKSMALLINT(CONTEXT_INSTS) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   914
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   915
! 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   916
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   917
flagBlockContext
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   918
    "return the flag code which marks BlockContext-type instances"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   919
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   920
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   921
    /* this is defined as a primitive to get defines from stc.h */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   922
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   923
    RETURN ( _MKSMALLINT(BCONTEXT_INSTS) );
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   924
%}
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   925
! 
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   926
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   927
flagFloat
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   928
    "return the flag code which marks Float-type instances"
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   929
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   930
%{  /* NOCONTEXT */
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   931
    /* this is defined as a primitive to get defines from stc.h */
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   932
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   933
    RETURN ( _MKSMALLINT(FLOAT_INSTS) );
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   934
%}
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   935
! 
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   936
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   937
flagSymbol
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   938
    "return the flag code which marks Symbol-type instances"
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   939
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   940
%{  /* NOCONTEXT */
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   941
    /* this is defined as a primitive to get defines from stc.h */
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   942
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
   943
    RETURN ( _MKSMALLINT(SYMBOL_INSTS) );
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   944
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   945
! !
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   946
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   947
!Behavior methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   948
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   949
name
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   950
    "although behaviors have no name, we return something
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   951
     useful here - there are many places (inspectors) where
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   952
     a classes name is asked for.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   953
     Implementing this message here allows anonymous classes
151
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
   954
     and instances of them to be inspected."
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   955
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   956
    ^ 'someBehavior'
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   957
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   958
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   959
superclass
a27a279701f8 Initial revision
claus
parents:
diff changeset
   960
    "return the receivers superclass"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   961
a27a279701f8 Initial revision
claus
parents:
diff changeset
   962
    ^ superclass
a27a279701f8 Initial revision
claus
parents:
diff changeset
   963
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   964
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   965
selectorArray 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   966
    "return the receivers selector array.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   967
     Notice: this is not compatible with ST-80."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   968
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   969
    ^ selectorArray
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   970
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   971
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   972
methodArray
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   973
    "return the receivers method array.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   974
     Notice: this is not compatible with ST-80."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   975
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   976
    ^ methodArray
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   977
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   978
a27a279701f8 Initial revision
claus
parents:
diff changeset
   979
methodDictionary
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   980
    "return the receivers method dictionary. 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   981
     Since no dictionary is actually present, create one for ST-80 compatibility."
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   982
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   983
    |dict|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   984
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   985
    dict := IdentityDictionary new.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
   986
    1 to:selectorArray size do:[:index |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
   987
	dict at:(selectorArray at:index) put:(methodArray at:index)
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   988
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   989
    ^ dict
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   990
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   991
a27a279701f8 Initial revision
claus
parents:
diff changeset
   992
instSize
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   993
    "return the number of instance variables of the receiver.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   994
     This includes all superclass instance variables."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   995
a27a279701f8 Initial revision
claus
parents:
diff changeset
   996
    ^ instSize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   997
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   998
a27a279701f8 Initial revision
claus
parents:
diff changeset
   999
flags
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1000
    "return the receivers flag bits"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1001
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1002
    ^ flags
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1003
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1004
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1005
sizeOfInst:n
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1006
    "return the number of bytes required for an instance of
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1007
     myself with n indexed instance variables. The argument n 
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1008
     should be zero for classes without indexed instance variables.
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1009
     See Behavior>>niceNew: for an application of this."
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1010
     
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1011
    |nInstvars|
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1012
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1013
    nInstvars := self instSize.
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1014
%{
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1015
    int nBytes;
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1016
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1017
    nBytes = _intVal(nInstvars) * sizeof(OBJ) + OHDR_SIZE; 
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1018
    if (_isSmallInteger(n)) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1019
	int nIndex;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1020
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1021
	nIndex = _intVal(n);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1022
	switch (_intVal(_INST(flags)) & ARRAYMASK) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1023
	    case BYTEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1024
		nBytes += nIndex;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1025
		if (nBytes & (ALIGN - 1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1026
		    nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1027
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1028
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1029
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1030
	    case WORDARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1031
		nBytes += nIndex * sizeof(short);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1032
		if (nBytes & (ALIGN - 1)) {
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1033
		    nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1034
		}
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1035
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1036
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1037
	    case LONGARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1038
		nBytes += nIndex * sizeof(long);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1039
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1040
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1041
	    case FLOATARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1042
		nBytes += nIndex * sizeof(float);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1043
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1044
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1045
	    case DOUBLEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1046
		nBytes += nIndex * sizeof(double);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1047
		break;
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1048
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1049
	    default:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1050
		nBytes += nIndex * sizeof(OBJ);
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1051
		break;
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1052
	}
127
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1053
    }
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1054
    RETURN (_MKSMALLINT(nBytes));
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1055
%}
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1056
!
6625c77d890f added sizeOfInst:
claus
parents: 92
diff changeset
  1057
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1058
isVariable
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1059
    "return true, if instances have indexed instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1060
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1061
    "this could be defined as:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1062
	^ (flags bitAnd:(Behavior maskIndexType)) ~~ 0
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1063
     "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1064
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1065
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1066
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1067
    RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? true : false ); 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1068
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1069
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1070
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1071
isFixed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1072
    "return true, if instances do not have indexed instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1073
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1074
    "this could be defined as:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1075
	^ self isVariable not
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1076
    "
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1077
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1078
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1079
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1080
    RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? false : true ); 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1081
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1082
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1083
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1084
isBits
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1085
    "return true, if instances have indexed byte or short instance variables.
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1086
     Ignore long, float and double arrays, since ST-80 code using isBits are probably
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1087
     not prepared to handle them correctly."
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1088
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1089
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1090
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1091
    REGISTER int flags;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1092
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1093
    RETURN ( (((flags = (_intVal(_INST(flags)) & ARRAYMASK)) == BYTEARRAY)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1094
	     || (flags == WORDARRAY)) ? true : false ); 
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1095
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1096
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1097
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1098
isBytes
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1099
    "return true, if instances have indexed byte instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1100
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1101
    "this could be defined as:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1102
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagBytes
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1103
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1104
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1105
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1106
    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == BYTEARRAY) ? true : false ); 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1107
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1108
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1109
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1110
isWords
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1111
    "return true, if instances have indexed short instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1112
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1113
    "this could be defined as:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1114
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagWords
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1115
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1116
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1117
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1118
    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == WORDARRAY) ? true : false ); 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1119
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1120
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1121
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1122
isLongs
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1123
    "return true, if instances have indexed long instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1124
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1125
    "this could be defined as:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1126
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagLongs
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1127
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1128
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1129
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1130
    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == LONGARRAY) ? true : false ); 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1131
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1132
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1133
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1134
isFloats
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1135
    "return true, if instances have indexed float instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1136
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1137
    "this could be defined as:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1138
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagFloats
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1139
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1140
%{  /* NOCONTEXT */
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1141
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1142
    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == FLOATARRAY) ? true : false ); 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1143
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1144
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1145
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1146
isDoubles
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1147
    "return true, if instances have indexed double instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1148
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1149
    "this could be defined as:
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1150
	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagDoubles
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1151
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1152
%{  /* NOCONTEXT */
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1153
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1154
    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == DOUBLEARRAY) ? true : false ); 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1155
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1156
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1157
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1158
isPointers
2
claus
parents: 1
diff changeset
  1159
    "return true, if instances have pointer instance variables 
claus
parents: 1
diff changeset
  1160
     i.e. are either non-indexed or have indexed pointer variables"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1161
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1162
    "QUESTION: should we ignore WeakPointers ?"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1163
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1164
%{  /* NOCONTEXT */
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1165
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1166
    REGISTER int flags;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1167
2
claus
parents: 1
diff changeset
  1168
    flags = _intVal(_INST(flags)) & ARRAYMASK;
claus
parents: 1
diff changeset
  1169
    switch (flags) {
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1170
	default:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1171
	    /* normal objects */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1172
	    RETURN ( true );
2
claus
parents: 1
diff changeset
  1173
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1174
	case BYTEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1175
	case WORDARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1176
	case LONGARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1177
	case FLOATARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1178
	case DOUBLEARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1179
	    RETURN (false );
2
claus
parents: 1
diff changeset
  1180
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1181
	case WKPOINTERARRAY:
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1182
	    /* what about those ? */
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1183
	    RETURN (true );
2
claus
parents: 1
diff changeset
  1184
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1185
%}
2
claus
parents: 1
diff changeset
  1186
!
claus
parents: 1
diff changeset
  1187
claus
parents: 1
diff changeset
  1188
superclass:aClass
claus
parents: 1
diff changeset
  1189
    "set the superclass - this actually creates a new class,
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1190
     recompiling all methods for the new one. The receiving class stays
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1191
     around anonymous to allow existing instances some life.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1192
     This may change in the future (adjusting existing instances)"
2
claus
parents: 1
diff changeset
  1193
claus
parents: 1
diff changeset
  1194
    "must flush caches since lookup chain changes"
claus
parents: 1
diff changeset
  1195
    ObjectMemory flushCaches.
10
claus
parents: 5
diff changeset
  1196
2
claus
parents: 1
diff changeset
  1197
"
claus
parents: 1
diff changeset
  1198
    superclass := aClass
claus
parents: 1
diff changeset
  1199
"
claus
parents: 1
diff changeset
  1200
    "for correct recompilation, just create a new class ..."
claus
parents: 1
diff changeset
  1201
claus
parents: 1
diff changeset
  1202
    aClass subclass:(self name)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1203
	   instanceVariableNames:(self instanceVariableString)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1204
	   classVariableNames:(self classVariableString)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1205
	   poolDictionaries:''
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1206
	   category:self category
2
claus
parents: 1
diff changeset
  1207
!
claus
parents: 1
diff changeset
  1208
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1209
addSuperclass:aClass
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1210
    "EXPERIMENTAL MI support: add aClass to the set of classes, from which instances
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1211
     inherit protocol."
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1212
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1213
    "first, check if the class is abstract - 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1214
     allows abstract mixins are allowed in the current implementation"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1215
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1216
    aClass instSize == 0 ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1217
	self error:'only abstract mixins allowed'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1218
	^ self
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1219
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1220
    otherSuperclasses isNil ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1221
	otherSuperclasses := Array with:aClass
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1222
    ] ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1223
	otherSuperclasses := otherSuperclasses copyWith:aClass
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1224
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1225
    ObjectMemory flushCaches
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1226
!
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1227
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1228
removeSuperclass:aClass
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1229
    "EXPERIMENTAL MI support: remove aClass from the set of classes, from which instances
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1230
     inherit protocol."
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1231
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1232
    otherSuperclasses notNil ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1233
	otherSuperclasses := otherSuperclasses copyWithout:aClass.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1234
	otherSuperclasses isEmpty ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1235
	    otherSuperclasses := nil
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1236
	].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1237
	ObjectMemory flushCaches
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1238
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1239
!
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1240
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1241
selectors:newSelectors methods:newMethods
2
claus
parents: 1
diff changeset
  1242
    "set both selector array and method array of the receiver,
claus
parents: 1
diff changeset
  1243
     and flush caches"
claus
parents: 1
diff changeset
  1244
claus
parents: 1
diff changeset
  1245
    ObjectMemory flushCaches.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1246
    selectorArray := newSelectors.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1247
    methodArray := newMethods
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1248
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1249
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1250
addSelector:newSelector withMethod:newMethod
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1251
    "add the method given by 2nd argument under the selector given by
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1252
     1st argument to the methodDictionary. Flush all caches."
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1253
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1254
    |nargs|
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1255
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1256
    (self primAddSelector:newSelector withLazyMethod:newMethod) ifFalse:[^ false].
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1257
    self changed:#methodDictionary with:newSelector.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1258
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1259
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1260
     if I have no subclasses, all we have to flush is cached
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1261
     data for myself ... (actually, in any case all that needs
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1262
     to be flushed is info for myself and all of my subclasses)
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1263
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1264
"
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1265
    problem: this is slower; since looking for all subclasses is (currently)
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1266
	     a bit slow :-(
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1267
	     We need the hasSubclasses-info bit in Behavior; now
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1268
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1269
    self withAllSubclassesDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1270
	ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1271
	ObjectMemory flushMethodCacheFor:aClass
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1272
    ].
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1273
"
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1274
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1275
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1276
     actually, we would do better with less flushing ...
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1277
    "
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1278
    nargs := newSelector numArgs.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1279
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1280
    ObjectMemory flushMethodCache.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1281
    ObjectMemory flushInlineCachesWithArgs:nargs.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1282
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1283
    ^ true
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1284
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1285
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1286
addSelector:newSelector withLazyMethod:newMethod
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1287
    "add the method given by 2nd argument under the selector given by
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1288
     1st argument to the methodDictionary. Since it does not flush
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1289
     any caches, this is only allowed for lazy methods."
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1290
92
0c73b48551ac *** empty log message ***
claus
parents: 91
diff changeset
  1291
    newMethod isLazyMethod ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1292
	self error:'operation only allowed for lazy methods'.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1293
	^ false
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1294
    ].
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1295
    (self primAddSelector:newSelector withLazyMethod:newMethod) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1296
	self changed:#methodDictionary with:newSelector.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1297
	^ true
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1298
    ].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1299
    ^ false
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1300
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1301
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1302
removeSelector:aSelector
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1303
    "remove the selector, aSelector and its associated method 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1304
     from the methodDictionary"
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1305
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1306
    |index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1307
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1308
    index := selectorArray identityIndexOf:aSelector startingAt:1.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1309
    (index == 0) ifTrue:[^ false].
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1310
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1311
    newSelectorArray := selectorArray copyWithoutIndex:index.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1312
    newMethodArray := methodArray copyWithoutIndex:index.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1313
    oldSelectorArray := selectorArray.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1314
    oldMethodArray := methodArray.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1315
    selectorArray := newSelectorArray.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1316
    methodArray := newMethodArray.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1317
"
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1318
    [
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1319
	|nargs|
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1320
	nargs := aSelector numArgs.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1321
	ObjectMemory flushMethodCache.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1322
	ObjectMemory flushInlineCachesWithArgs:nargs.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1323
    ] value
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1324
"
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1325
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1326
     actually, we would do better with less flushing ...
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1327
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1328
    ObjectMemory flushCaches.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1329
    ^ true
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1330
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1331
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1332
!Behavior methodsFor:'queries'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1333
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1334
isBehavior
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
  1335
    "return true, if the receiver is describing another objects behavior,
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1336
     i.e. is a class. Defined to avoid the need to use isKindOf:"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1337
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1338
    ^ true
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1339
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1340
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1341
     True isBehavior   
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1342
     true isBehavior
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1343
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1344
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1345
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
  1346
canBeSubclassed
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
  1347
    "return true, if its allowed to create subclasses of the receiver.
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
  1348
     This method is redefined in SmallInteger and UndefinedObject, since
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1349
     instances are detected by their pointer-fields, i.e. they do not have
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1350
     a class entry (you dont have to understand this :-)"
47
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
  1351
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
  1352
    ^ true
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
  1353
!
93f17a1b452c *** empty log message ***
claus
parents: 45
diff changeset
  1354
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1355
hasMultipleSuperclasses
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1356
    "Return true, if this class inherits from other classes 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1357
     (beside its primary superclass). 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1358
     This method is a preparation for a future multiple inheritance extension 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1359
     - currently it is not supported by the VM"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1360
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1361
    ^ otherSuperclasses notNil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1362
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1363
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1364
superclasses
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1365
    "return a collection of the receivers immediate superclasses.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1366
     This method is a preparation for a future multiple inheritance extension 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1367
     - currently it is not supported by the VM"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1368
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1369
    otherSuperclasses notNil ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1370
	^ (Array with:superclass) , otherSuperclasses
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1371
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1372
    ^ Array with:superclass
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1373
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1374
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1375
     String superclasses  
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1376
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1377
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1378
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1379
allSuperclasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1380
    "return a collection of the receivers accumulated superclasses"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1381
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1382
    |aCollection theSuperClass|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1383
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1384
    theSuperClass := superclass.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1385
    theSuperClass notNil ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1386
	aCollection := OrderedCollection new.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1387
	[theSuperClass notNil] whileTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1388
	    aCollection add:theSuperClass.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1389
	    theSuperClass := theSuperClass superclass
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1390
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1391
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1392
    ^ aCollection
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1393
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1394
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1395
     String allSuperclasses 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1396
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1397
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1398
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1399
withAllSuperclasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1400
    "return a collection containing the receiver and all
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1401
     of the receivers accumulated superclasses"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1402
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1403
    |aCollection theSuperClass|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1404
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1405
    aCollection := OrderedCollection with:self.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1406
    theSuperClass := superclass.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1407
    [theSuperClass notNil] whileTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1408
	aCollection add:theSuperClass.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1409
	theSuperClass := theSuperClass superclass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1410
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1411
    ^ aCollection
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1412
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1413
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1414
     String withAllSuperclasses 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1415
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1416
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1417
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1418
subclasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1419
    "return a collection of the direct subclasses of the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1420
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1421
    |newColl|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1422
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1423
    newColl := OrderedCollection new.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1424
    self subclassesDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1425
	newColl add:aClass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1426
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1427
    ^ newColl
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1428
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1429
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1430
     Collection subclasses
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1431
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1432
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1433
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1434
allSubclasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1435
    "return a collection of all subclasses (direct AND indirect) of
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1436
     the receiver. There will be no specific order, in which entries
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1437
     are returned."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1438
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1439
    |newColl|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1440
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1441
    newColl := OrderedCollection new.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1442
    self allSubclassesDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1443
	newColl add:aClass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1444
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1445
    ^ newColl
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1446
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1447
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1448
     Collection allSubclasses
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1449
    "
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1450
!
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1451
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1452
allSubclassesInOrder
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1453
    "return a collection of all subclasses (direct AND indirect) of
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1454
     the receiver. Higher level subclasses will come before lower ones."
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1455
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1456
    |newColl|
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1457
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1458
    newColl := OrderedCollection new.
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1459
    self allSubclassesInOrderDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1460
	newColl add:aClass
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1461
    ].
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1462
    ^ newColl
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1463
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1464
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1465
     Collection allSubclassesInOrder
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1466
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1467
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1468
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1469
withAllSubclasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1470
    "return a collection containing the receiver and 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1471
     all subclasses (direct AND indirect) of the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1472
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1473
    |newColl|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1474
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1475
    newColl := OrderedCollection with:self.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1476
    self allSubclassesDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1477
	newColl add:aClass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1478
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1479
    ^ newColl
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1480
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1481
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1482
     Collection withAllSubclasses
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1483
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1484
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1485
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1486
isSubclassOf:aClass
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1487
    "return true, if I am a subclass of the argument, aClass"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1488
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1489
    |theClass|
2
claus
parents: 1
diff changeset
  1490
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1491
    theClass := superclass.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1492
    [theClass notNil] whileTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1493
	(theClass == aClass) ifTrue:[^ true].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1494
	theClass := theClass superclass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1495
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1496
    ^ false
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1497
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1498
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1499
     String isSubclassOf:Collection  
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1500
     LinkedList isSubclassOf:Array   
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1501
     1 isSubclassOf:Number              <- will fail since 1 is no class
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1502
    "     
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1503
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1504
151
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1505
allInstVarNames
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1506
    "return a collection of all the instance variable name-strings
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1507
     this includes all superclass-instance variables.
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1508
     Since Behavior has no idea of instvar-names, return an empty collection
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1509
     here. Redefined in ClassDescription."
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1510
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1511
    ^ #()
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1512
!
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1513
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1514
allClassVarNames
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1515
    "return a collection of all the class variable name-strings
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1516
     this includes all superclass-class variables.
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1517
     Since Behavior has no idea of classvar-names, return an empty collection
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1518
     here. Redefined in ClassDescription."
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1519
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1520
    ^ #()
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1521
!
07c448be12b6 *** empty log message ***
claus
parents: 127
diff changeset
  1522
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1523
allInstances
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1524
    "return a collection of all my instances"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1525
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1526
    |coll|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1527
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1528
    coll := OrderedCollection new.
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1529
    self allInstancesDo:[:anObject |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1530
	coll add:anObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1531
    ].
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1532
    ^ coll 
25
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1533
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1534
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1535
     ScrollBar allInstances
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1536
    "
25
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1537
!
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1538
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1539
allDerivedInstances
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1540
    "return a collection of all instances of myself and 
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1541
     instances of all subclasses of myself"
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1542
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1543
    |coll|
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1544
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1545
    coll := OrderedCollection new.
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1546
    self allDerivedInstancesDo:[:anObject |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1547
	(anObject isKindOf:self) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1548
	    coll add:anObject
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1549
	]
25
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1550
    ].
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1551
    ^ coll 
25
e34a6267c79b *** empty log message ***
claus
parents: 11
diff changeset
  1552
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1553
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1554
     View allDerivedInstances
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1555
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1556
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1557
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1558
hasInstances
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1559
    "return true, if there are any instances of myself"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1560
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1561
    ObjectMemory allObjectsDo:[:anObject |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1562
	(anObject class == self) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1563
	    ^ true
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1564
	]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1565
    ].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1566
    ^ false
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1567
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1568
    "
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1569
     Object hasInstances
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1570
     SequenceableCollection hasInstances
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1571
     Float hasInstances
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1572
    "
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1573
!
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1574
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1575
instanceCount
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1576
    "return the number of instances of myself"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1577
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1578
    |count|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1579
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1580
    count := 0.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1581
    ObjectMemory allObjectsDo:[:anObject |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1582
	(anObject class == self) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1583
	    count := count + 1
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1584
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1585
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1586
    ^ count
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1587
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1588
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1589
     View instanceCount
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1590
     Object instanceCount
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1591
     Float instanceCount
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1592
     SequenceableCollection instanceCount
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1593
    "
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1594
!
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1595
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1596
derivedInstanceCount
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1597
    "return the number of instances of myself and of subclasses"
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1598
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1599
    |count|
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1600
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1601
    count := 0.
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1602
    ObjectMemory allObjectsDo:[:anObject |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1603
	(anObject isKindOf:self) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1604
	    count := count + 1
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1605
	]
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1606
    ].
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1607
    ^ count
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1608
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1609
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1610
     View derivedInstanceCount
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1611
     SequenceableCollection derivedInstanceCount
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1612
    "
2
claus
parents: 1
diff changeset
  1613
!
claus
parents: 1
diff changeset
  1614
claus
parents: 1
diff changeset
  1615
selectorIndex:aSelector
claus
parents: 1
diff changeset
  1616
    "return the index in the arrays for given selector aSelector"
claus
parents: 1
diff changeset
  1617
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1618
    ^ selectorArray identityIndexOf:aSelector startingAt:1
2
claus
parents: 1
diff changeset
  1619
!
claus
parents: 1
diff changeset
  1620
claus
parents: 1
diff changeset
  1621
compiledMethodAt:aSelector
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1622
    "return the method for given selector aSelector or nil.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1623
     Only methods in the receiver - not in the superclass chain are tested."
2
claus
parents: 1
diff changeset
  1624
claus
parents: 1
diff changeset
  1625
    |index|
claus
parents: 1
diff changeset
  1626
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1627
    index := selectorArray identityIndexOf:aSelector startingAt:1.
2
claus
parents: 1
diff changeset
  1628
    (index == 0) ifTrue:[^ nil].
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1629
    ^ methodArray at:index
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1630
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1631
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1632
     Object compiledMethodAt:#==
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1633
     (Object compiledMethodAt:#==) category
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1634
    "
2
claus
parents: 1
diff changeset
  1635
!
claus
parents: 1
diff changeset
  1636
claus
parents: 1
diff changeset
  1637
sourceCodeAt:aSelector
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1638
    "return the methods source for given selector aSelector or nil.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1639
     Only methods in the receiver - not in the superclass chain are tested."
2
claus
parents: 1
diff changeset
  1640
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
  1641
    |method|
2
claus
parents: 1
diff changeset
  1642
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
  1643
    method := self compiledMethodAt:aSelector.
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
  1644
    method isNil ifTrue:[^ nil].
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
  1645
    ^ method source
2
claus
parents: 1
diff changeset
  1646
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1647
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1648
     True sourceCodeAt:#ifTrue:
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1649
     Object sourceCodeAt:#==
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1650
     Behavior sourceCodeAt:#sourceCodeAt:
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1651
    "
2
claus
parents: 1
diff changeset
  1652
!
claus
parents: 1
diff changeset
  1653
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1654
lookupMethodFor:aSelector
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1655
    "return the method, which would be executed if aSelector was sent to
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1656
     an instance of the receiver. I.e. the selector arrays of the receiver
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1657
     and all of its superclasses are searched for aSelector.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1658
     Return the method, or nil if instances do not understand aSelector.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1659
     EXPERIMENTAL: take care of multiple superclasses."
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1660
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1661
    |m cls|
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1662
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1663
    cls := self.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1664
    [cls notNil] whileTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1665
	m := cls compiledMethodAt:aSelector.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1666
	m notNil ifTrue:[^ m].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1667
	cls hasMultipleSuperclasses ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1668
	    cls superclasses do:[:aSuperClass |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1669
		m := aSuperClass lookupMethodFor:aSelector.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1670
		m notNil ifTrue:[^ m].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1671
	    ].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1672
	    ^ nil
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1673
	] ifFalse:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1674
	    cls := cls superclass
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1675
	]
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1676
    ].
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1677
    ^ nil
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1678
!
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1679
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1680
cachedLookupMethodFor:aSelector
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1681
    "return the method, which would be executed if aSelector was sent to
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1682
     an instance of the receiver. I.e. the selector arrays of the receiver
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1683
     and all of its superclasses are searched for aSelector.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1684
     Return the method, or nil if instances do not understand aSelector.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1685
     This interface provides exactly the same information as #lookupMethodFor:,
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1686
     but uses the lookup-cache in the VM for faster search. 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1687
     However, keep in mind, that doing a lookup through the cache also adds new
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1688
     entries and can thus slow down the system by polluting the cache with 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1689
     irrelevant entries. (do NOT loop over all objects calling this method).
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1690
     Does NOT (currently) handle MI"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1691
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1692
%{  /* NOCONTEXT */
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1693
    extern OBJ lookup();
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1694
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1695
    RETURN ( lookup(self, aSelector, SENDER) );
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1696
%}
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1697
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1698
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1699
     String cachedLookupMethodFor:#=
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1700
     String cachedLookupMethodFor:#asOrderedCollection
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1701
    "
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1702
!
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1703
2
claus
parents: 1
diff changeset
  1704
hasMethods
claus
parents: 1
diff changeset
  1705
    "return true, if there are any (local) methods in this class"
claus
parents: 1
diff changeset
  1706
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1707
    ^ (methodArray size ~~ 0)
10
claus
parents: 5
diff changeset
  1708
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1709
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1710
     True hasMethods
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1711
     True class hasMethods
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1712
    "
2
claus
parents: 1
diff changeset
  1713
!
claus
parents: 1
diff changeset
  1714
claus
parents: 1
diff changeset
  1715
implements:aSelector
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1716
    "return true, if the receiver implements aSelector.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1717
     (i.e. implemented in THIS class - NOT in a superclass).
10
claus
parents: 5
diff changeset
  1718
     Dont use this method to check if someone responds to a message -
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1719
     use #canUnderstand: on the class or #respondsTo: on the instance
10
claus
parents: 5
diff changeset
  1720
     to do this."
2
claus
parents: 1
diff changeset
  1721
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1722
    ^ (selectorArray identityIndexOf:aSelector startingAt:1) ~~ 0
2
claus
parents: 1
diff changeset
  1723
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1724
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1725
     True implements:#ifTrue:
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1726
     True implements:#==
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1727
    "
2
claus
parents: 1
diff changeset
  1728
!
claus
parents: 1
diff changeset
  1729
claus
parents: 1
diff changeset
  1730
canUnderstand:aSelector
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1731
    "return true, if the receiver or one of its superclasses implements aSelector.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1732
     (i.e. true if my instances understand aSelector)"
2
claus
parents: 1
diff changeset
  1733
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1734
    ^ (self lookupMethodFor:aSelector) notNil
10
claus
parents: 5
diff changeset
  1735
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1736
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1737
     True canUnderstand:#ifTrue:
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1738
     True canUnderstand:#==
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1739
     True canUnderstand:#do:
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1740
    "
2
claus
parents: 1
diff changeset
  1741
!
claus
parents: 1
diff changeset
  1742
claus
parents: 1
diff changeset
  1743
whichClassImplements:aSelector
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1744
    "return the class in the inheritance chain, which implements the method
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1745
     for aSelector; return nil if none.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1746
     EXPERIMENTAL: handle multiple superclasses"
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1747
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1748
    |cls|
2
claus
parents: 1
diff changeset
  1749
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1750
    cls := self.
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1751
    [cls notNil] whileTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1752
	(cls implements:aSelector) ifTrue:[^ cls].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1753
	cls hasMultipleSuperclasses ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1754
	    cls superclasses do:[:aSuperClass |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1755
		|implementingClass|
2
claus
parents: 1
diff changeset
  1756
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1757
		implementingClass := aSuperClass whichClassImplements:aSelector.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1758
		implementingClass notNil ifTrue:[^ implementingClass].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1759
	    ].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1760
	    ^ nil
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1761
	] ifFalse:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1762
	    cls := cls superclass
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1763
	]
2
claus
parents: 1
diff changeset
  1764
    ].
claus
parents: 1
diff changeset
  1765
    ^ nil
claus
parents: 1
diff changeset
  1766
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1767
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1768
     String whichClassImplements:#==
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1769
     String whichClassImplements:#collect:
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1770
    "
2
claus
parents: 1
diff changeset
  1771
!
claus
parents: 1
diff changeset
  1772
claus
parents: 1
diff changeset
  1773
inheritsFrom:aClass
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1774
    "return true, if the receiver inherits methods from aClass"
2
claus
parents: 1
diff changeset
  1775
claus
parents: 1
diff changeset
  1776
    ^ self isSubclassOf:aClass
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1777
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1778
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1779
     True inheritsFrom:Object
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1780
     LinkedList inheritsFrom:Array
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1781
    "
2
claus
parents: 1
diff changeset
  1782
!
claus
parents: 1
diff changeset
  1783
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1784
selectorAtMethod:aMethod ifAbsent:failBlock
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1785
    "return the selector for given method aMethod
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1786
     or the value of failBlock, if not found."
2
claus
parents: 1
diff changeset
  1787
claus
parents: 1
diff changeset
  1788
    |index|
claus
parents: 1
diff changeset
  1789
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1790
    index := methodArray identityIndexOf:aMethod startingAt:1.
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1791
    (index == 0) ifTrue:[^ failBlock value].
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1792
    ^ selectorArray at:index
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1793
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1794
    "
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1795
     |m|
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1796
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1797
     m := Object compiledMethodAt:#copy.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1798
     Object selectorAtMethod:m ifAbsent:'oops'].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1799
    "
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1800
    "
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1801
     |m|
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1802
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1803
     m := Object compiledMethodAt:#copy.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1804
     Fraction selectorAtMethod:m ifAbsent:'oops'].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1805
    "
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1806
!
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1807
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1808
selectorForMethod:aMethod
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1809
    "Return the selector for given method aMethod."
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1810
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1811
    ^ self selectorAtMethod:aMethod ifAbsent:[nil]
2
claus
parents: 1
diff changeset
  1812
!
claus
parents: 1
diff changeset
  1813
claus
parents: 1
diff changeset
  1814
containsMethod:aMethod
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1815
    "Return true, if the argument, aMethod is a method of myself"
2
claus
parents: 1
diff changeset
  1816
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1817
    methodArray isNil ifTrue:[^ false].  "degenerated class"
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1818
    ^ (methodArray identityIndexOf:aMethod startingAt:1) ~~ 0
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1819
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1820
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1821
!Behavior methodsFor:'private accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1822
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1823
setSuperclass:sup selectors:sels methods:m instSize:i flags:f
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1824
    "set some inst vars. 
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1825
     this method is for special uses only - there will be no recompilation
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1826
     and no change record written here; 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1827
     Do NOT use it."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1828
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1829
    superclass := sup.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1830
    selectorArray := sels.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1831
    methodArray := m.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1832
    instSize := i.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1833
    flags := f
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1834
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1835
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1836
setSuperclass:aClass
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1837
    "set the superclass of the receiver.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1838
     this method is for special uses only - there will be no recompilation
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1839
     and no change record written here; 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1840
     Do NOT use it."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1841
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1842
    superclass := aClass
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1843
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1844
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1845
setOtherSuperclasses:anArrayOfClasses
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1846
    "EXPERIMENTAL: set the other superclasses of the receiver.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1847
     this method is for special uses only - there will be no recompilation
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1848
     and no change record written here; 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1849
     Do NOT use it."
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1850
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1851
    otherSuperclasses := anArrayOfClasses
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1852
!
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1853
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1854
instSize:aNumber
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1855
    "set the instance size.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1856
     this method is for special uses only - there will be no recompilation
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1857
     and no change record written here; 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1858
     Do NOT use it."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1859
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1860
    instSize := aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1861
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1862
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1863
flags:aNumber
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1864
    "set the flags.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1865
     this method is for special uses only - there will be no recompilation
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1866
     and no change record written here; 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1867
     Do NOT use it."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1868
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1869
    flags := aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1870
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1871
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1872
setSelectors:sels methods:m
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1873
    "set some inst vars. 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1874
     this method is for special uses only - there will be no recompilation
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1875
     and no change record written here; 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1876
     Do NOT use it."
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1877
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1878
    selectorArray := sels.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1879
    methodArray := m.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1880
!
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1881
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1882
setSelectorArray:anArray
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1883
    "set the selector array of the receiver.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1884
     this method is for special uses only - there will be no recompilation
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1885
     and no change record written here.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1886
     NOT for general use."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1887
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1888
    selectorArray := anArray
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1889
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1890
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1891
setMethodArray:anArray
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1892
    "set the method array of the receiver.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1893
     this method is for special uses only - there will be no recompilation
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1894
     and no change record written here.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1895
     NOT for general use."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1896
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1897
    methodArray := anArray
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1898
!
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1899
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1900
setMethodDictionary:aDictionary
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1901
    "set the receivers method dictionary. 
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1902
     Since no dictionary is actually used, decompose into selector- and
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1903
     method arrays and set those. For ST-80 compatibility.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1904
     NOT for general use."
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1905
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1906
    |n newSelectorArray newMethodArray idx|
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1907
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1908
    n := aDictionary size.
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1909
    newSelectorArray := Array new:n.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1910
    newMethodArray := Array new:n.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1911
    idx := 1.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1912
    aDictionary keysAndValuesDo:[:sel :method |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1913
	newSelectorArray at:idx put:sel.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1914
	newMethodArray at:idx put:method.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1915
	idx := idx + 1
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1916
    ].
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1917
    selectorArray := newSelectorArray.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1918
    methodArray := newMethodArray
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1919
!
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1920
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1921
primAddSelector:newSelector withLazyMethod:newMethod
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1922
    "add the method given by 2nd argument under the selector given by
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1923
     the 1st argument to the methodDictionary. 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1924
     Does NOT flush any caches.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1925
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1926
     Do not use this in normal situations, strange behavior will be
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1927
     the consequence.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1928
     I.e. executing obsolete methods, since the old method will still 
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1929
     be executed out of the caches."
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1930
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1931
    |index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1932
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1933
    (newSelector isMemberOf:Symbol) ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1934
	self error:'invalid selector'. 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1935
	^ false
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1936
    ].
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1937
    newMethod isNil ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1938
	self error:'invalid method'. 
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1939
	^ false
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1940
    ].
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1941
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1942
    index := selectorArray identityIndexOf:newSelector startingAt:1.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1943
    (index == 0) ifTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1944
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1945
	 a new selector
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1946
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1947
	newSelectorArray := selectorArray copyWith:newSelector.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1948
	newMethodArray := methodArray copyWith:newMethod.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1949
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1950
	 keep a reference so they wont go away ...
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1951
	 mhmh: this is no longer needed - try without
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1952
	"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1953
	oldSelectorArray := selectorArray.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1954
	oldMethodArray := methodArray.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1955
	selectorArray := newSelectorArray.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1956
	methodArray := newMethodArray
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1957
    ] ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1958
	methodArray at:index put:newMethod
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1959
    ].
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1960
    ^ true
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1961
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1962
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1963
!Behavior methodsFor:'compiler interface'!
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1964
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1965
compiler
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1966
    "return the compiler to use for this class - 
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1967
     this can be redefined in special classes, to get classes with
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1968
     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1969
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1970
    ^ Compiler
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1971
! !
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  1972
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1973
!Behavior methodsFor:'enumeration'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1974
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1975
allInstancesDo:aBlock
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1976
    "evaluate aBlock for all of my instances"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1977
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1978
    ObjectMemory allObjectsDo:[:anObject |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1979
	(anObject class == self) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1980
	    aBlock value:anObject
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1981
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1982
    ]
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1983
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1984
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1985
     StandardSystemView allInstancesDo:[:v | Transcript showCr:(v name)]
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1986
    "
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1987
!
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1988
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1989
allDerivedInstancesDo:aBlock
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1990
    "evaluate aBlock for all of my instances and all instances of subclasses"
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1991
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1992
    ObjectMemory allObjectsDo:[:anObject |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1993
	(anObject isKindOf:self) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1994
	    aBlock value:anObject
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  1995
	]
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1996
    ]
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  1997
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1998
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  1999
     StandardSystemView allDerivedInstancesDo:[:v | Transcript showCr:(v name)]
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2000
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2001
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2002
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2003
subclassesDo:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2004
    "evaluate the argument, aBlock for all immediate subclasses"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2005
2
claus
parents: 1
diff changeset
  2006
    Smalltalk allBehaviorsDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2007
	(aClass superclass == self) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2008
	    aBlock value:aClass
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2009
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2010
    ]
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2011
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2012
    "
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2013
     Collection subclassesDo:[:c | Transcript showCr:(c name)]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2014
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2015
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2016
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2017
allSubclassesDo:aBlock
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2018
    "evaluate aBlock for all of my subclasses.
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2019
     There is no specific order, in which the entries are enumerated."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2020
2
claus
parents: 1
diff changeset
  2021
    Smalltalk allBehaviorsDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2022
	(aClass isSubclassOf:self) ifTrue:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2023
	    aBlock value:aClass
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2024
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2025
    ]
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2026
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2027
    "Collection allSubclassesDo:[:c | Transcript showCr:(c name)]"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2028
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2029
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2030
allSubclassesInOrderDo:aBlock
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2031
    "evaluate aBlock for all of my subclasses.
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2032
     Higher level subclasses will be enumerated before the deeper ones"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2033
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2034
    self subclassesDo:[:aClass |
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2035
	aBlock value:aClass.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2036
	aClass allSubclassesInOrderDo:aBlock
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2037
    ]
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2038
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2039
    "Collection allSubclassesInOrderDo:[:c | Transcript showCr:(c name)]"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2040
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2041
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2042
allSuperclassesDo:aBlock
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2043
    "evaluate aBlock for all of my superclasses"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2044
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2045
    |theClass|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2046
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2047
    theClass := superclass.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2048
    [theClass notNil] whileTrue:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2049
	aBlock value:theClass.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2050
	theClass := theClass superclass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2051
    ]
45
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2052
0c270a39d4a2 *** empty log message ***
claus
parents: 43
diff changeset
  2053
    "String allSuperclassesDo:[:c | Transcript showCr:(c name)]"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2054
! !
2
claus
parents: 1
diff changeset
  2055
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
  2056
!Behavior methodsFor:'binary storage'!
2
claus
parents: 1
diff changeset
  2057
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2058
readBinaryFrom:aStream
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2059
    "read an objects binary representation from the argument,
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2060
     aStream and return it. 
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2061
     The read object must be a kind of myself 
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2062
     - to get any object, use 'Object readBinaryFrom:...',
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2063
       to get any number, use 'Number readBinaryFrom:...' and so on.
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2064
     This is the reverse operation to 'storeBinaryOn:'. "
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2065
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2066
    |newObject|
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2067
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2068
    newObject := (BinaryInputManager new:1024) readFrom:aStream.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2069
    (newObject isKindOf:self) ifFalse:[
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2070
	self error:('expected ' , self name)
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2071
    ].
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2072
    ^ newObject
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2073
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2074
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2075
     |s|
11
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2076
     s := WriteStream on:ByteArray new.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2077
     #(1 2 3 4) storeBinaryOn:s.
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2078
     Object readBinaryFrom:(ReadStream on:s contents)  
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2079
    "
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2080
!
6bf3080856be *** empty log message ***
claus
parents: 10
diff changeset
  2081
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2082
storeBinaryDefinitionOn: stream manager: manager
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2083
    "classes will store the name only and restore by looking for
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2084
     that name in the Smalltalk dictionary."
2
claus
parents: 1
diff changeset
  2085
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2086
    | myName |
2
claus
parents: 1
diff changeset
  2087
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2088
    myName := self name.
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2089
    stream nextNumber:4 put:self signature.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2090
    stream nextNumber:2 put:myName size.
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2091
    myName do:[:c| 
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2092
	stream nextPut:c asciiValue
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2093
    ]
91
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2094
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2095
    "
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2096
     |s|
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2097
     s := WriteStream on:ByteArray new.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2098
     #(1 2 3 4) storeBinaryOn:s.
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2099
     Object readBinaryFrom:(ReadStream on:s contents)  
b3971c7dc731 *** empty log message ***
claus
parents: 88
diff changeset
  2100
    "
2
claus
parents: 1
diff changeset
  2101
!
claus
parents: 1
diff changeset
  2102
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2103
binaryDefinitionFrom:stream manager:manager
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2104
    "read the definition on an empty instance (of my class) from stream.
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2105
     All pointer instances are left nil, while all bits are read in here.
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2106
     return the new object."
2
claus
parents: 1
diff changeset
  2107
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2108
    |obj t
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2109
     basicSize "{ Class: SmallInteger }" |
2
claus
parents: 1
diff changeset
  2110
claus
parents: 1
diff changeset
  2111
    self isPointers ifTrue: [
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2112
	stream next. "skip instSize"
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2113
	self isVariable ifTrue: [
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2114
	    ^ self basicNew:(stream nextNumber:3)
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2115
	].
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2116
	^ self basicNew
2
claus
parents: 1
diff changeset
  2117
    ].
claus
parents: 1
diff changeset
  2118
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2119
    basicSize := stream nextNumber:4.
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2120
    obj := self basicNew:basicSize.
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2121
2
claus
parents: 1
diff changeset
  2122
    self isBytes ifTrue: [
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2123
	stream nextBytes:basicSize into:obj
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2124
"
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2125
	1 to:basicSize do:[:i |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2126
	    obj basicAt:i put:stream next
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2127
	]
43
00ca34676cbf *** empty log message ***
claus
parents: 25
diff changeset
  2128
"
2
claus
parents: 1
diff changeset
  2129
    ] ifFalse: [
154
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2130
	self isWords ifTrue: [
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2131
	    1 to:basicSize do:[:i |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2132
		obj basicAt:i put: stream nextNumber:2
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2133
	    ]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2134
	] ifFalse:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2135
	    self isLongs ifTrue: [
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2136
		1 to:basicSize do:[:i |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2137
		    obj basicAt:i put: stream nextNumber:4
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2138
		]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2139
	    ] ifFalse:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2140
		self isFloats ifTrue: [
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2141
		    "could do it in one big read on machines which use IEEE floats ..."
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2142
		    1 to:basicSize do:[:i |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2143
			t := Float basicNew.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2144
			Float readBinaryIEEESingleFrom:stream into:t.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2145
			obj basicAt:i put: t
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2146
		    ]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2147
		] ifFalse:[
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2148
		    self isDoubles ifTrue: [
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2149
			"could do it in one big read on machines which use IEEE doubles ..."
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2150
			1 to:basicSize do:[:i |
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2151
			    t := Float basicNew.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2152
			    Float readBinaryIEEEDoubleFrom:stream into:t.
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2153
			    obj basicAt:i put: t
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2154
			]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2155
		    ]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2156
		]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2157
	    ]
d4236ec280a6 *** empty log message ***
claus
parents: 151
diff changeset
  2158
	]
2
claus
parents: 1
diff changeset
  2159
    ].
claus
parents: 1
diff changeset
  2160
    ^obj
claus
parents: 1
diff changeset
  2161
! !