Object.st
author Claus Gittinger <cg@exept.de>
Mon, 23 Oct 1995 17:55:03 +0100
changeset 443 fae13c0f1512
parent 438 6c03b347369f
child 446 9005802b114a
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1988 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 143
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:#Object
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
       instanceVariableNames:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    15
       classVariableNames:'ErrorSignal HaltSignal 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    16
			   MessageNotUnderstoodSignal UserInterruptSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    17
			   RecursionInterruptSignal ExceptionInterruptSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    18
			   SubscriptOutOfBoundsSignal NonIntegerIndexSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    19
			   NotFoundSignal KeyNotFoundSignal ElementOutOfBoundsSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    20
			   InformationSignal PrimitiveFailureSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    21
			   DeepCopyErrorSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    22
			   AbortSignal
356
claus
parents: 348
diff changeset
    23
			   ErrorRecursion Dependencies
claus
parents: 348
diff changeset
    24
			   InfoPrinting'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    25
       poolDictionaries:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    26
       category:'Kernel-Objects'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    27
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    28
a27a279701f8 Initial revision
claus
parents:
diff changeset
    29
Object comment:'
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
    30
COPYRIGHT (c) 1988 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    31
	      All Rights Reserved
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    32
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
    33
$Header: /cvs/stx/stx/libbasic/Object.st,v 1.65 1995-10-23 16:54:15 cg Exp $
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    34
'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    35
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    36
!Object class methodsFor:'documentation'!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    37
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
 COPYRIGHT (c) 1988 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    41
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    45
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    47
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    49
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    50
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    51
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    52
version
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    53
"
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
    54
$Header: /cvs/stx/stx/libbasic/Object.st,v 1.65 1995-10-23 16:54:15 cg Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    55
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    56
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    57
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    58
documentation
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    59
"
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    60
   Object is the superclass of all other classes. Protocol common to
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    61
   every object is defined here.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    62
   Also some utility stuff (like notify) and error handling is implemented here.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    63
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    64
   Object has no instance variables (and may not get any added). One reason is, that
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    65
   UndefinedObject and SmallInteger are also inheriting from Object - these two cannot have instance
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
    66
   variables (due to their implementation). The other reason is that the runtime system
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    67
   (VM) knows about the layout of some built-in classes (think of Class, Method, Block
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    68
   and also Integer or Float). If you where allowed to add instance variables to Object, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    69
   the VM had to be recompiled (and also rewritten in some places).
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    70
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    71
   Class variables:
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    72
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    73
	ErrorSignal     <Signal>        Signal raised for error/error: messages
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    74
					also, parent of all other signals.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    75
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    76
	HaltSignal      <Signal>        Signal raised for halt/halt: messages
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    77
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    78
	MessageNotUnderstoodSignal      Signals raised for various error conditions
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    79
	UserInterruptSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    80
	RecursionInterruptSignal 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    81
	ExceptionInterruptSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    82
	SubscriptOutOfBoundsSignal 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    83
	NonIntegerIndexSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    84
	NotFoundSignal 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    85
	KeyNotFoundSignal 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    86
	ElementOutOfBoundsSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    87
	InformationSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    88
	DeepCopyErrorSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    89
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    90
	AbortSignal      <Signal>       Signal raised by debugger, to abort a computation
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    91
					BUT, the debugger will only raise it if it is handled.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    92
					By handling the abortSignal, you can control where the
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    93
					debuggers abort-function resumes execution in case of
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    94
					an error.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    95
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    96
	ErrorRecursion   <Boolean>      controls behavior when recursive errors occur (i.e. 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    97
					an error while handling an error).
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    98
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
    99
	Dependencies     <Dictionary>   keeps track of object dependencies
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   100
"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   101
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
!Object class methodsFor:'initialization'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   104
a27a279701f8 Initial revision
claus
parents:
diff changeset
   105
initialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   106
    "called only once - initialize signals"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
a27a279701f8 Initial revision
claus
parents:
diff changeset
   108
    ErrorSignal isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   109
	ErrorSignal := (Signal new) mayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   110
	ErrorSignal nameClass:self message:#errorSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   111
	ErrorSignal notifierString:'error encountered'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   112
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   113
	HaltSignal := ErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   114
	HaltSignal nameClass:self message:#haltSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   115
	HaltSignal notifierString:'halt encountered'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   116
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   117
	MessageNotUnderstoodSignal := ErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   118
	MessageNotUnderstoodSignal nameClass:self message:#messageNotUnderstoodSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   119
	MessageNotUnderstoodSignal notifierString:'message not understood'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   120
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   121
	PrimitiveFailureSignal := ErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   122
	PrimitiveFailureSignal nameClass:self message:#primitiveFailureSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   123
	PrimitiveFailureSignal notifierString:'primitive failed'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   124
362
claus
parents: 359
diff changeset
   125
"/        UserInterruptSignal := ErrorSignal newSignalMayProceed:true.
claus
parents: 359
diff changeset
   126
	UserInterruptSignal := (Signal new) newSignalMayProceed:true.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   127
	UserInterruptSignal nameClass:self message:#userInterruptSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   128
	UserInterruptSignal notifierString:'user Interrupt'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   129
362
claus
parents: 359
diff changeset
   130
"/        RecursionInterruptSignal := ErrorSignal newSignalMayProceed:false.
claus
parents: 359
diff changeset
   131
	RecursionInterruptSignal := (Signal new) mayProceed:true.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   132
	RecursionInterruptSignal nameClass:self message:#recursionInterruptSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   133
	RecursionInterruptSignal notifierString:'recursion limit reached'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   134
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   135
	ExceptionInterruptSignal := ErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   136
	ExceptionInterruptSignal nameClass:self message:#exceptionInterruptSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   137
	ExceptionInterruptSignal notifierString:'exception Interrupt'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   138
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   139
	SubscriptOutOfBoundsSignal := ErrorSignal newSignalMayProceed:false.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   140
	SubscriptOutOfBoundsSignal nameClass:self message:#subscriptOutOfBoundsSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   141
	SubscriptOutOfBoundsSignal notifierString:'subscript out of bounds'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   142
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   143
	ElementOutOfBoundsSignal := ErrorSignal newSignalMayProceed:false.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   144
	ElementOutOfBoundsSignal nameClass:self message:#elementOutOfBoundsSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   145
	ElementOutOfBoundsSignal notifierString:'element not appropriate or out of bounds'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   146
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   147
	NotFoundSignal := ErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   148
	NotFoundSignal nameClass:self message:#notFoundSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   149
	NotFoundSignal notifierString:'no such element'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   150
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   151
	KeyNotFoundSignal := ErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   152
	KeyNotFoundSignal nameClass:self message:#keyNotFoundSignal.
345
claus
parents: 343
diff changeset
   153
	KeyNotFoundSignal notifierString:'no such key:'.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   154
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   155
	NonIntegerIndexSignal := ErrorSignal newSignalMayProceed:false.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   156
	NonIntegerIndexSignal nameClass:self message:#nonIntegerIndexSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   157
	NonIntegerIndexSignal notifierString:'index must be integer'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   158
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   159
	InformationSignal := ErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   160
	InformationSignal nameClass:self message:#informationSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   161
	InformationSignal notifierString:'information'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   162
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   163
	DeepCopyErrorSignal := ErrorSignal newSignalMayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   164
	DeepCopyErrorSignal nameClass:self message:#deepCopyErrorSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   165
	DeepCopyErrorSignal notifierString:'object cannot be deepCopy-ed'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   166
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   167
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   168
	 AbortSignal is not a child of ErrorSignal -
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   169
	 this would complicate abort from within a signal handler
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   170
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   171
	AbortSignal := Signal new mayProceed:true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   172
	AbortSignal nameClass:self message:#abortSignal.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   173
	AbortSignal notifierString:'unhandled abort signal'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   174
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   175
	Dependencies isNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   176
	    Dependencies := WeakIdentityDictionary new.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   177
	]
356
claus
parents: 348
diff changeset
   178
    ].
claus
parents: 348
diff changeset
   179
    InfoPrinting := true
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
a27a279701f8 Initial revision
claus
parents:
diff changeset
   181
    "Object initialize"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   182
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   183
345
claus
parents: 343
diff changeset
   184
!Object class methodsFor:'Signal constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   185
a27a279701f8 Initial revision
claus
parents:
diff changeset
   186
errorSignal
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   187
    "return the signal used for error/error: - handling"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   188
a27a279701f8 Initial revision
claus
parents:
diff changeset
   189
    ^ ErrorSignal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   191
a27a279701f8 Initial revision
claus
parents:
diff changeset
   192
haltSignal
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   193
    "return the signal used for halt/halt: - handling"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   194
a27a279701f8 Initial revision
claus
parents:
diff changeset
   195
    ^ HaltSignal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   196
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   197
a27a279701f8 Initial revision
claus
parents:
diff changeset
   198
messageNotUnderstoodSignal
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   199
    "return the signal used for doesNotUnderstand: - error handling"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
    ^ MessageNotUnderstoodSignal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   202
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   203
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   204
privateMethodSignal
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   205
    "return the signal used for privateMethod - error handling"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   206
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   207
    ^ MessageNotUnderstoodSignal
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   208
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   209
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   210
primitiveFailureSignal
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   211
    "return the signal used for primitiveFailed - error handling"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   212
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   213
    ^ PrimitiveFailureSignal
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   214
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   215
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   216
userInterruptSignal
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   217
    "return the signal used for ^C interrupts handling"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   218
a27a279701f8 Initial revision
claus
parents:
diff changeset
   219
    ^ UserInterruptSignal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   220
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   221
a27a279701f8 Initial revision
claus
parents:
diff changeset
   222
recursionInterruptSignal 
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   223
    "return the signal used for recursion overflow error handling"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   224
a27a279701f8 Initial revision
claus
parents:
diff changeset
   225
    ^ RecursionInterruptSignal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   226
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   227
a27a279701f8 Initial revision
claus
parents:
diff changeset
   228
exceptionInterruptSignal
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   229
    "return the signal used for exception (display errors) error handling"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   230
a27a279701f8 Initial revision
claus
parents:
diff changeset
   231
    ^ ExceptionInterruptSignal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   232
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   233
2
claus
parents: 1
diff changeset
   234
subscriptOutOfBoundsSignal
claus
parents: 1
diff changeset
   235
    "return the signal used for subscript error reporting.
claus
parents: 1
diff changeset
   236
     (this signal is used for example when an array is accessed with an
claus
parents: 1
diff changeset
   237
      index less than 1 or greater than the array size)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   238
2
claus
parents: 1
diff changeset
   239
    ^ SubscriptOutOfBoundsSignal
claus
parents: 1
diff changeset
   240
!
claus
parents: 1
diff changeset
   241
claus
parents: 1
diff changeset
   242
elementOutOfBoundsSignal
claus
parents: 1
diff changeset
   243
    "return the signal used for element error reporting
claus
parents: 1
diff changeset
   244
     (this signal is used for example when a value not in 0..255 is to
claus
parents: 1
diff changeset
   245
      be put into a bytearray)"
claus
parents: 1
diff changeset
   246
claus
parents: 1
diff changeset
   247
    ^ ElementOutOfBoundsSignal
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   248
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   249
a27a279701f8 Initial revision
claus
parents:
diff changeset
   250
nonIntegerIndexSignal 
a27a279701f8 Initial revision
claus
parents:
diff changeset
   251
    "return the signal used for bad subscript error reporting"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   252
a27a279701f8 Initial revision
claus
parents:
diff changeset
   253
    ^ NonIntegerIndexSignal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   254
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   255
2
claus
parents: 1
diff changeset
   256
notFoundSignal 
345
claus
parents: 343
diff changeset
   257
    "return the signal used for no element found error reporting"
2
claus
parents: 1
diff changeset
   258
claus
parents: 1
diff changeset
   259
    ^ NotFoundSignal
claus
parents: 1
diff changeset
   260
!
claus
parents: 1
diff changeset
   261
claus
parents: 1
diff changeset
   262
keyNotFoundSignal 
claus
parents: 1
diff changeset
   263
    "return the signal used for no such key error reporting"
claus
parents: 1
diff changeset
   264
claus
parents: 1
diff changeset
   265
    ^ KeyNotFoundSignal
claus
parents: 1
diff changeset
   266
!
claus
parents: 1
diff changeset
   267
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   268
informationSignal 
a27a279701f8 Initial revision
claus
parents:
diff changeset
   269
    "return the signal used for informations"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   270
a27a279701f8 Initial revision
claus
parents:
diff changeset
   271
    ^ InformationSignal
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
   272
!
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
   273
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   274
deepCopyErrorSignal 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   275
    "return the signal raised when a deepcopy is asked for
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   276
     an object which cannot do this (for example, BlockClosures
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   277
     or Contexts)."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   278
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   279
    ^ DeepCopyErrorSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   280
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   281
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
   282
abortSignal 
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   283
    "return the signal used to abort user actions. This signal is only
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   284
     raised if cought (by the debugger), and will lead way out of the
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   285
     currently active doIt/printIt or inspectIt. (also some others use
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   286
     this for a save abort)"
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
   287
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
   288
    ^ AbortSignal
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   289
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   290
356
claus
parents: 348
diff changeset
   291
!Object class methodsFor:'info messages'!
claus
parents: 348
diff changeset
   292
claus
parents: 348
diff changeset
   293
infoPrinting:aBoolean
claus
parents: 348
diff changeset
   294
    "turn on/off printing of information messages.
claus
parents: 348
diff changeset
   295
     If the argument, aBoolean is false, infoPrint will not output
claus
parents: 348
diff changeset
   296
     messages. The default is true."
claus
parents: 348
diff changeset
   297
claus
parents: 348
diff changeset
   298
    InfoPrinting := aBoolean
375
claus
parents: 370
diff changeset
   299
!
claus
parents: 370
diff changeset
   300
claus
parents: 370
diff changeset
   301
infoPrinting
claus
parents: 370
diff changeset
   302
    "return the flag which controls information messages."
claus
parents: 370
diff changeset
   303
claus
parents: 370
diff changeset
   304
    ^ InfoPrinting
356
claus
parents: 348
diff changeset
   305
! !
claus
parents: 348
diff changeset
   306
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   307
!Object class methodsFor:'queries'!
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   308
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   309
isBuiltInClass
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   310
    "return true, if this class is known by the run-time-system,
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   311
     i.e. you cannot add/remove instance variables without recompiling
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   312
     the VM."
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   313
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   314
    ^ self == Object
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   315
! !
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   316
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   317
!Object methodsFor:'initialization'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   318
a27a279701f8 Initial revision
claus
parents:
diff changeset
   319
initialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   320
    "just to ignore initialize to objects which do not need it"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   321
a27a279701f8 Initial revision
claus
parents:
diff changeset
   322
    ^ self
421
claus
parents: 403
diff changeset
   323
! !
claus
parents: 403
diff changeset
   324
claus
parents: 403
diff changeset
   325
!Object ignoredMethodsFor:'initialization'!
380
claus
parents: 379
diff changeset
   326
claus
parents: 379
diff changeset
   327
fromLiteralArrayEncoding:aSpecArray
claus
parents: 379
diff changeset
   328
    "read my values from a specArray. The argument is supposed to
claus
parents: 379
diff changeset
   329
     consist of setSelector/value pairs, which are sent to the receiver.
claus
parents: 379
diff changeset
   330
     Some classes (Point, Rectangle) redefine this for a slightly more compact
claus
parents: 379
diff changeset
   331
     literal representation.
claus
parents: 379
diff changeset
   332
     This was added to allow for VW windowSpecs to be parsed in ST/X;
claus
parents: 379
diff changeset
   333
     do not use if for general object printing/restoring."
claus
parents: 379
diff changeset
   334
384
claus
parents: 380
diff changeset
   335
    |sz "{Class: SmallInteger }"|
380
claus
parents: 379
diff changeset
   336
claus
parents: 379
diff changeset
   337
    sz := aSpecArray size.
claus
parents: 379
diff changeset
   338
    2 to:sz  by:2 do:[:i | 
claus
parents: 379
diff changeset
   339
	self perform:(aSpecArray at:i) with:(aSpecArray at:i+1)
claus
parents: 379
diff changeset
   340
    ]
claus
parents: 379
diff changeset
   341
claus
parents: 379
diff changeset
   342
    "
claus
parents: 379
diff changeset
   343
     (Association new) fromLiteralArrayEncoding:#(#dummy #key: 1 #value: 'one')
claus
parents: 379
diff changeset
   344
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   345
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   346
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   347
!Object methodsFor:'cleanup'!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   348
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   349
lowSpaceCleanup
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   350
    "ignored here - redefined in some classes to
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   351
     cleanup in low-memory situations"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   352
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   353
    ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   354
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   355
a27a279701f8 Initial revision
claus
parents:
diff changeset
   356
!Object methodsFor:'system primitives'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   357
a27a279701f8 Initial revision
claus
parents:
diff changeset
   358
become:anotherObject
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   359
    "make all references to the receiver become references to anotherObject
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   360
     and vice-versa. This may be an expensive (i.e. slow) operation, 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   361
     since in the worst case, the whole memory has to be searched for 
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   362
     references to the two objects (although the primitive tries hard to
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   363
     limit the search, for acceptable performance in most cases). 
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   364
     In general, using become: should be avoided if possible, since it may 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   365
     produce many strange effects (think of hashing in Sets).
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   366
     This method fails, if the receiver or the argument is a SmallInteger 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   367
     or nil, or is a context of a living method (i.e. one that has not already 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   368
     returned).
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   369
     (notice that become: is not used heavily by the system 
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   370
      - the Collection-classes have been rewritten to not use it.)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   371
%{
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   372
    if (__primBecome(self, anotherObject COMMA_CON))
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   373
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   374
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   375
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   376
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
   377
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   378
10
claus
parents: 5
diff changeset
   379
becomeNil
claus
parents: 5
diff changeset
   380
    "make all references to the receiver become nil - effectively getting
claus
parents: 5
diff changeset
   381
     rid of the receiver. This can be a very dangerous operation - be warned.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   382
     The receiver may not be a SmallInteger or a context of a living method."
10
claus
parents: 5
diff changeset
   383
claus
parents: 5
diff changeset
   384
%{
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   385
    if (__primBecomeNil(self COMMA_CON ))
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   386
	RETURN ( nil );
10
claus
parents: 5
diff changeset
   387
%}
claus
parents: 5
diff changeset
   388
.
claus
parents: 5
diff changeset
   389
    self primitiveFailed
claus
parents: 5
diff changeset
   390
!
claus
parents: 5
diff changeset
   391
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   392
changeClassTo:otherClass
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   393
    "changes the class of the receiver to the argument, otherClass.
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   394
     This is only allowed (possible), if the receivers class and the argument
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   395
     have the same structure (i.e. number of named instance variables and
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   396
     type of indexed instance variables). 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   397
     If the structures do not match, or any of the original class or new class
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   398
     is UndefinedObject or a Smallinteger, a primitive error is triggered."
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   399
85
claus
parents: 77
diff changeset
   400
    |myClass ok|
claus
parents: 77
diff changeset
   401
claus
parents: 77
diff changeset
   402
    "check for UndefinedObject/SmallInteger receiver or newClass"
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   403
%{
329
claus
parents: 325
diff changeset
   404
    if (__isNonNilObject(self) 
claus
parents: 325
diff changeset
   405
     && __isNonNilObject(otherClass)
85
claus
parents: 77
diff changeset
   406
     && (otherClass != UndefinedObject)
claus
parents: 77
diff changeset
   407
     && (otherClass != SmallInteger)) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   408
	ok = true;
85
claus
parents: 77
diff changeset
   409
    } else {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   410
	ok = false;
85
claus
parents: 77
diff changeset
   411
    }
claus
parents: 77
diff changeset
   412
%}.
claus
parents: 77
diff changeset
   413
    ok ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   414
	ok := false.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   415
	myClass := self class.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   416
	myClass flags == otherClass flags ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   417
	    myClass instSize == otherClass instSize ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   418
		"same instance layout and types: its ok to do it"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   419
		ok := true.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   420
	    ] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   421
		myClass isPointers ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   422
		    myClass isVariable ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   423
			ok := true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   424
		    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   425
		]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   426
	    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   427
	] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   428
	    myClass isPointers ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   429
		"if newClass is a variable class, with instSize <= my instsize,
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   430
		 we can do it (effectively mapping additional instvars into the
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   431
		 variable part) - usefulness is questionable, though"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   432
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   433
		otherClass isPointers ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   434
		    otherClass isVariable ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   435
			otherClass instSize <= (myClass instSize + self basicSize) 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   436
			ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   437
			    ok := true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   438
			]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   439
		    ] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   440
			otherClass instSize == (myClass instSize + self basicSize) 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   441
			ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   442
			    ok := true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   443
			]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   444
		    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   445
		] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   446
		    "it does not make sense to convert pointers to bytes ..."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   447
		]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   448
	    ] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   449
		"does it make sense, to convert bits ?"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   450
		"could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   451
	    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   452
	]
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   453
    ].
85
claus
parents: 77
diff changeset
   454
    ok ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   455
	"now, change the receivers class ..."
85
claus
parents: 77
diff changeset
   456
%{
329
claus
parents: 325
diff changeset
   457
	__qClass(self) = otherClass;
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   458
	__STORE(self, otherClass);
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   459
	RETURN ( self );
85
claus
parents: 77
diff changeset
   460
%}.
claus
parents: 77
diff changeset
   461
    ].
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   462
    self primitiveFailed
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   463
!
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   464
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   465
changeClassToThatOf:anObject
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   466
    "changes the class of the receiver to that of the argument, anObject.
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   467
     This is only allowed (possible), if the receivers class and the arguments
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   468
     class have the same structure (i.e. number of named instance variables and 
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   469
     type of indexed instance variables). If the structures do not match, or any
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   470
     of the objects is nil or a Smallinteger, a primitive error is triggered."
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   471
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   472
    self changeClassTo:(anObject class)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   473
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   474
a27a279701f8 Initial revision
claus
parents:
diff changeset
   475
!Object methodsFor:'queries'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   476
a27a279701f8 Initial revision
claus
parents:
diff changeset
   477
size
a27a279701f8 Initial revision
claus
parents:
diff changeset
   478
    "return the number of the receivers indexed instance variables;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   479
     this method may be redefined in subclasses"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   480
a27a279701f8 Initial revision
claus
parents:
diff changeset
   481
    ^ self basicSize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   482
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   483
a27a279701f8 Initial revision
claus
parents:
diff changeset
   484
basicSize
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   485
    "return the number of the receivers indexed instance variables,
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   486
     0 if it has none.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   487
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   488
     This method should NOT be redefined in any subclass"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   489
a27a279701f8 Initial revision
claus
parents:
diff changeset
   490
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   491
329
claus
parents: 325
diff changeset
   492
    REGISTER int nbytes;
claus
parents: 325
diff changeset
   493
    REGISTER OBJ myClass;
claus
parents: 325
diff changeset
   494
    REGISTER int flags;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   495
a27a279701f8 Initial revision
claus
parents:
diff changeset
   496
    /*
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   497
     * notice the missing test for self being a nonNilObject -
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   498
     * this can be done since basicSize is defined both in UndefinedObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   499
     * and SmallInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   500
     */
329
claus
parents: 325
diff changeset
   501
    myClass = __qClass(self);
claus
parents: 325
diff changeset
   502
    nbytes = __qSize(self) 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   503
	      - OHDR_SIZE 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   504
	      - __OBJS2BYTES__(_intVal(_ClassInstPtr(myClass)->c_ninstvars));
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   505
329
claus
parents: 325
diff changeset
   506
    flags = _intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK;
claus
parents: 325
diff changeset
   507
    /*
claus
parents: 325
diff changeset
   508
     * replaced switch by open-if; this is slightly faster since
claus
parents: 325
diff changeset
   509
     * it avoids the range check and also checks the most common case first
claus
parents: 325
diff changeset
   510
     */
claus
parents: 325
diff changeset
   511
    if ((flags == POINTERARRAY)
claus
parents: 325
diff changeset
   512
     || (flags == WKPOINTERARRAY)) {
claus
parents: 325
diff changeset
   513
	RETURN ( _MKSMALLINT(__BYTES2OBJS__(nbytes)) );
claus
parents: 325
diff changeset
   514
    }
claus
parents: 325
diff changeset
   515
    if (flags == BYTEARRAY) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   516
	    RETURN ( _MKSMALLINT(nbytes / sizeof(char)) );
329
claus
parents: 325
diff changeset
   517
    }
claus
parents: 325
diff changeset
   518
    if (flags == FLOATARRAY) {
claus
parents: 325
diff changeset
   519
	RETURN ( _MKSMALLINT(nbytes / sizeof(float)) );
claus
parents: 325
diff changeset
   520
    }
claus
parents: 325
diff changeset
   521
    if (flags == DOUBLEARRAY) {
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   522
#ifdef NEED_DOUBLE_ALIGN
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   523
	    /*
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   524
	     * care for filler
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   525
	     */
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   526
	    nbytes -= sizeof(FILLTYPE);
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   527
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   528
	    RETURN ( _MKSMALLINT(nbytes / sizeof(double)) );
329
claus
parents: 325
diff changeset
   529
    }
claus
parents: 325
diff changeset
   530
    if (flags == LONGARRAY) {
claus
parents: 325
diff changeset
   531
	RETURN ( _MKSMALLINT(nbytes / sizeof(long)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   532
    }
329
claus
parents: 325
diff changeset
   533
    if (flags == WORDARRAY) {
claus
parents: 325
diff changeset
   534
	RETURN ( _MKSMALLINT(nbytes / sizeof(short)) );
claus
parents: 325
diff changeset
   535
    }
claus
parents: 325
diff changeset
   536
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   537
    ^ 0
a27a279701f8 Initial revision
claus
parents:
diff changeset
   538
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   539
a27a279701f8 Initial revision
claus
parents:
diff changeset
   540
isVariable
a27a279701f8 Initial revision
claus
parents:
diff changeset
   541
    "return true if the receiver has indexed instance variables,
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   542
     false otherwise."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   543
a27a279701f8 Initial revision
claus
parents:
diff changeset
   544
    ^ self class isVariable
a27a279701f8 Initial revision
claus
parents:
diff changeset
   545
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   546
a27a279701f8 Initial revision
claus
parents:
diff changeset
   547
isFixedSize
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
   548
    "return true if the receiver cannot grow easily 
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
   549
     (i.e. a grow may be expensive, since it involves a become:)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   550
a27a279701f8 Initial revision
claus
parents:
diff changeset
   551
    ^ true
a27a279701f8 Initial revision
claus
parents:
diff changeset
   552
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   553
a27a279701f8 Initial revision
claus
parents:
diff changeset
   554
class
a27a279701f8 Initial revision
claus
parents:
diff changeset
   555
    "return the receivers class"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   556
a27a279701f8 Initial revision
claus
parents:
diff changeset
   557
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   558
329
claus
parents: 325
diff changeset
   559
    RETURN ( __Class(self) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   560
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   561
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   562
a27a279701f8 Initial revision
claus
parents:
diff changeset
   563
species
a27a279701f8 Initial revision
claus
parents:
diff changeset
   564
    "return a class which is similar to (or the same as) the receivers class.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   565
     This is used to create an appropriate object when creating derived
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   566
     copies in the collection classes (sometimes redefined)."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   567
a27a279701f8 Initial revision
claus
parents:
diff changeset
   568
    ^ self class
a27a279701f8 Initial revision
claus
parents:
diff changeset
   569
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   570
a27a279701f8 Initial revision
claus
parents:
diff changeset
   571
yourself
a27a279701f8 Initial revision
claus
parents:
diff changeset
   572
    "return the receiver - used for cascades to return self at the end"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   573
a27a279701f8 Initial revision
claus
parents:
diff changeset
   574
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   575
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   576
a27a279701f8 Initial revision
claus
parents:
diff changeset
   577
isBehavior
a27a279701f8 Initial revision
claus
parents:
diff changeset
   578
    "return true, if the receiver is some kind of class (i.e. behavior);
259
   579
     false is returned here - the method is only redefined in Behavior."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   580
a27a279701f8 Initial revision
claus
parents:
diff changeset
   581
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   582
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   583
2
claus
parents: 1
diff changeset
   584
isClass
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   585
    "return true, if the receiver is some kind of class (real class, 
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   586
     not just behavior);
259
   587
     false is returned here - the method is only redefined in Class."
2
claus
parents: 1
diff changeset
   588
claus
parents: 1
diff changeset
   589
    ^ false
claus
parents: 1
diff changeset
   590
!
claus
parents: 1
diff changeset
   591
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   592
isMeta
a27a279701f8 Initial revision
claus
parents:
diff changeset
   593
    "return true, if the receiver is some kind of metaclass;
259
   594
     false is returned here - the method is only redefined in Metaclass."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   595
a27a279701f8 Initial revision
claus
parents:
diff changeset
   596
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   597
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   598
a27a279701f8 Initial revision
claus
parents:
diff changeset
   599
isBlock
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   600
    "return true, if the receiver is some kind of block;
259
   601
     false returned here - the method is only redefined in Block."
   602
   603
    ^ false
   604
!
   605
   606
isMethod
   607
    "return true, if the receiver is some kind of method;
   608
     false returned here - the method is only redefined in Method."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   609
a27a279701f8 Initial revision
claus
parents:
diff changeset
   610
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   611
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   612
a27a279701f8 Initial revision
claus
parents:
diff changeset
   613
isContext
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   614
    "return true, if the receiver is some kind of context;
259
   615
     false returned here - the method is only redefined in Context."
   616
   617
    ^ false
   618
!
   619
   620
isSignal
   621
    "return true, if the receiver is some kind of signal;
   622
     false returned here - the method is only redefined in Signal."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   623
a27a279701f8 Initial revision
claus
parents:
diff changeset
   624
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   625
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   626
a27a279701f8 Initial revision
claus
parents:
diff changeset
   627
isStream
a27a279701f8 Initial revision
claus
parents:
diff changeset
   628
    "return true, if the receiver is some kind of stream;
259
   629
     false is returned here - the method is only redefined in Stream."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   630
a27a279701f8 Initial revision
claus
parents:
diff changeset
   631
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   632
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   633
438
claus
parents: 421
diff changeset
   634
isExternalStream
claus
parents: 421
diff changeset
   635
    "return true, if the receiver is some kind of externalStream;
claus
parents: 421
diff changeset
   636
     false is returned here - the method is only redefined in ExternalStream."
claus
parents: 421
diff changeset
   637
claus
parents: 421
diff changeset
   638
    ^false
claus
parents: 421
diff changeset
   639
!
claus
parents: 421
diff changeset
   640
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   641
isFileStream
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   642
    "return true, if the receiver is some kind of fileStream;
259
   643
     false is returned here - the method is only redefined in FileStream."
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   644
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   645
    ^false
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   646
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   647
259
   648
isCollection
   649
    "return true, if the receiver is some kind of collection;
   650
     false is returned here - the method is only redefined in Collection."
   651
   652
    ^ false
   653
!
   654
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   655
isSequenceable
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   656
    "return true, if the receiver is some kind of sequenceable collection;
259
   657
     false is returned here - the method is only redefined in SequenceableCollection."
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   658
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   659
    ^ false
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   660
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   661
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   662
isSequenceableCollection
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   663
    "OBSOLETE: use isSequenceable for ST-80 compatibility.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   664
     This method is a historic leftover and will be removed soon ..."
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   665
359
claus
parents: 357
diff changeset
   666
    self obsoleteMethodWarning:'use #isSequenceable'.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   667
    ^ false
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   668
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   669
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   670
isColor
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   671
    "return true, if the receiver is some kind of color;
259
   672
     false is returned here - the method is only redefined in Color."
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   673
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   674
    ^ false
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   675
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   676
370
claus
parents: 369
diff changeset
   677
isArray
claus
parents: 369
diff changeset
   678
    "return true, if the receiver is some kind of array (or weakArray etc);
claus
parents: 369
diff changeset
   679
     false is returned here - the method is only redefined in Array."
claus
parents: 369
diff changeset
   680
claus
parents: 369
diff changeset
   681
    ^ false
claus
parents: 369
diff changeset
   682
!
claus
parents: 369
diff changeset
   683
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   684
isString
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   685
    "return true, if the receiver is some kind of string;
259
   686
     false is returned here - the method is only redefined in String."
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   687
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   688
    ^ false
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   689
!
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   690
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   691
isSymbol
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   692
    "return true, if the receiver is some kind of symbol;
259
   693
     false is returned here - the method is only redefined in Symbol."
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   694
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   695
    ^ false
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   696
!
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   697
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   698
isCharacter
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   699
    "return true, if the receiver is some kind of character;
259
   700
     false is returned here - the method is only redefined in Character."
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   701
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   702
    ^ false
2
claus
parents: 1
diff changeset
   703
!
claus
parents: 1
diff changeset
   704
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   705
isNumber
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   706
    "return true, if the receiver is some kind of number;
259
   707
     false is returned here - the method is only redefined in Number."
   708
   709
    ^ false
   710
!
   711
   712
isFraction
   713
    "return true, if the receiver is some kind of fraction;
   714
     false is returned here - the method is only redefined in Fraction."
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   715
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   716
    ^ false
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   717
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   718
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   719
isInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   720
    "return true, if the receiver is some kind of integer number;
259
   721
     false is returned here - the method is only redefined in Integer."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   722
a27a279701f8 Initial revision
claus
parents:
diff changeset
   723
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   724
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   725
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   726
isPoint
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   727
    "return true, if the receiver is some kind of point;
259
   728
     false is returned here - the method is only redefined in Point."
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   729
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   730
    ^ false
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   731
!
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   732
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   733
isRectangle
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   734
    "return true, if the receiver is some kind of rectangle;
259
   735
     false is returned here - the method is only redefined in Rectangle."
   736
   737
    ^ false
   738
!
   739
339
claus
parents: 332
diff changeset
   740
isLayout
claus
parents: 332
diff changeset
   741
    "return true, if the receiver is some kind of layout;
claus
parents: 332
diff changeset
   742
     false is returned here - the method is only redefined in Layout."
claus
parents: 332
diff changeset
   743
claus
parents: 332
diff changeset
   744
    ^ false
claus
parents: 332
diff changeset
   745
!
claus
parents: 332
diff changeset
   746
259
   747
isForm
   748
    "return true, if the receiver is some kind of form;
   749
     false is returned here - the method is only redefined in Form."
   750
   751
    ^ false
   752
!
   753
   754
isImage
   755
    "return true, if the receiver is some kind of image;
   756
     false is returned here - the method is only redefined in Image."
   757
   758
    ^ false
   759
!
   760
   761
isImageOrForm
   762
    "return true, if the receiver is some kind of image or form;
   763
     false is returned here - the method is only redefined in Image and Form."
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   764
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   765
    ^ false
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   766
!
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   767
329
claus
parents: 325
diff changeset
   768
isView
claus
parents: 325
diff changeset
   769
    "return true, if the receiver is some kind of view;
claus
parents: 325
diff changeset
   770
     false is returned here - the method is only redefined in View."
claus
parents: 325
diff changeset
   771
claus
parents: 325
diff changeset
   772
    ^ false
claus
parents: 325
diff changeset
   773
!
claus
parents: 325
diff changeset
   774
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   775
isLiteral
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   776
    "return true, if the receiver can be represented as a constant in ST syntax;
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   777
     false is returned here - the method is redefined in some classes."
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   778
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   779
    ^ false
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   780
!
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   781
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   782
isMemberOf:aClass
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
   783
    "return true, if the receiver is an instance of aClass, false otherwise.
259
   784
     Advice: 
   785
	use of this to check objects for certain attributes/protocoll should
   786
	be avoided; it limits the reusability of your classes by limiting use
   787
	to instances of a certain class.
   788
	Use check-methods to check an object for a certain attributes/protocol
   789
	(such as #isXXX, #respondsTo: or #isNumber);
   790
   791
	Using #isMemberOf: is considered BAD STYLE."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   792
a27a279701f8 Initial revision
claus
parents:
diff changeset
   793
    ^ (self class) == aClass
a27a279701f8 Initial revision
claus
parents:
diff changeset
   794
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   795
a27a279701f8 Initial revision
claus
parents:
diff changeset
   796
isKindOf:aClass
a27a279701f8 Initial revision
claus
parents:
diff changeset
   797
    "return true, if the receiver is an instance of aClass or one of its
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
   798
     subclasses, false otherwise.
259
   799
     Advice: 
   800
	use of this to check objects for certain attributes/protocoll should
   801
	be avoided; it limits the reusability of your classes by limiting use
   802
	to instances of certain classes and fences you into a specific inheritance 
   803
	hierarchy.
   804
	Use check-methods to check an object for a certain attributes/protocol
   805
	(such as #isXXXX, #respondsTo: or #isNumber).
   806
   807
	Using #isKindOf: is considered BAD STYLE.
   808
   809
     Advice2:
325
claus
parents: 324
diff changeset
   810
	Be aware, that using an #isXXX method is usually much faster than 
claus
parents: 324
diff changeset
   811
	using #isKindOf:; because isKindOf: has to walk up all the superclass 
claus
parents: 324
diff changeset
   812
	hierarchy, comparing every class on the way. 
claus
parents: 324
diff changeset
   813
	Due to caching in the VM, a call to #isXXX is normally reached via
claus
parents: 324
diff changeset
   814
	a single function call.
259
   815
     "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   816
a27a279701f8 Initial revision
claus
parents:
diff changeset
   817
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   818
    register OBJ thisClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   819
329
claus
parents: 325
diff changeset
   820
    thisClass = __Class(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   821
    while (thisClass != nil) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   822
	if (thisClass == aClass) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   823
	    RETURN ( true );
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   824
	}
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   825
	thisClass = _ClassInstPtr(thisClass)->c_superclass;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   826
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   827
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   828
.
85
claus
parents: 77
diff changeset
   829
"/
claus
parents: 77
diff changeset
   830
"/  the above code is equivalent to:
claus
parents: 77
diff changeset
   831
"/
claus
parents: 77
diff changeset
   832
"/  thisClass := self class.
claus
parents: 77
diff changeset
   833
"/  [thisClass notNil] whileTrue:[
claus
parents: 77
diff changeset
   834
"/      thisClass == aClass ifTrue:[^ true].
claus
parents: 77
diff changeset
   835
"/      thisClass := thisClass superclass
claus
parents: 77
diff changeset
   836
"/  ]
claus
parents: 77
diff changeset
   837
"/
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   838
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   839
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   840
a27a279701f8 Initial revision
claus
parents:
diff changeset
   841
respondsTo:aSelector
a27a279701f8 Initial revision
claus
parents:
diff changeset
   842
    "return true, if the receiver implements a method with selector equal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   843
     to aSelector; i.e. if there is a method for aSelector in either the
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   844
     receivers class or one of its superclasses.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   845
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   846
     Notice, that this does not imply, that such a message can be sent without
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   847
     an error being raised. For example, an implementation could send
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   848
     #shouldNotImplement or #subclassResponsibility."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   849
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   850
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   851
     should we go via the cache, or search (by class) ?
259
   852
     The first is faster, most of the time; while the 2nd fills
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   853
     the cache with useless data if this is sent in a loop over all objects.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   854
     For now, use the cache ...
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   855
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   856
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   857
362
claus
parents: 359
diff changeset
   858
    extern OBJ __lookup();
claus
parents: 359
diff changeset
   859
claus
parents: 359
diff changeset
   860
    if (__lookup(__Class(self), aSelector) == nil) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   861
	RETURN ( false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   862
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   863
    RETURN ( true );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   864
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   865
.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   866
"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   867
    ^ self class canUnderstand:aSelector
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   868
"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   869
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   870
    "'aString' respondsTo:#+"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   871
    "'aString' respondsTo:#,"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   872
    "'aString' respondsTo:#collect:"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   873
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   874
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   875
respondsToArithmetic
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   876
    "return true, if the receiver responds to arithmetic messages.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   877
     false is returned here - the method is redefined in ArithmeticValue."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   878
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   879
    ^ false
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   880
! !
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   881
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   882
!Object methodsFor:'special queries'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   883
a27a279701f8 Initial revision
claus
parents:
diff changeset
   884
references:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   885
    "return true, if the receiver refers to the argument, anObject.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   886
     - for debugging only"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   887
a27a279701f8 Initial revision
claus
parents:
diff changeset
   888
    |myClass 
a27a279701f8 Initial revision
claus
parents:
diff changeset
   889
     numInst "{ Class: SmallInteger }" |
a27a279701f8 Initial revision
claus
parents:
diff changeset
   890
369
claus
parents: 362
diff changeset
   891
%{
claus
parents: 362
diff changeset
   892
    /*
claus
parents: 362
diff changeset
   893
     * a little optimization: use the fact that all old objects
claus
parents: 362
diff changeset
   894
     * refering to a new object are on the remSet; if I am not,
claus
parents: 362
diff changeset
   895
     * a trivial reject is possible, if anObject is a newbee
claus
parents: 362
diff changeset
   896
     */
claus
parents: 362
diff changeset
   897
    if (__isNonNilObject(self) && __isNonNilObject(anObject)) {
claus
parents: 362
diff changeset
   898
	if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
claus
parents: 362
diff changeset
   899
	    int spc;
claus
parents: 362
diff changeset
   900
claus
parents: 362
diff changeset
   901
	    if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
claus
parents: 362
diff changeset
   902
		RETURN (false);
claus
parents: 362
diff changeset
   903
	    }
claus
parents: 362
diff changeset
   904
	}
claus
parents: 362
diff changeset
   905
    }
claus
parents: 362
diff changeset
   906
%}.
claus
parents: 362
diff changeset
   907
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   908
    myClass := self class.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   909
a27a279701f8 Initial revision
claus
parents:
diff changeset
   910
    "check the class"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   911
    (myClass == anObject) ifTrue:[^ true].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   912
a27a279701f8 Initial revision
claus
parents:
diff changeset
   913
    "check the instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   914
    numInst := myClass instSize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   915
    1 to:numInst do:[:i | 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   916
	((self instVarAt:i) == anObject) ifTrue:[^ true]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   917
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   918
a27a279701f8 Initial revision
claus
parents:
diff changeset
   919
    "check the indexed variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   920
    myClass isVariable ifTrue:[
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   921
	myClass isPointers ifFalse:[
369
claus
parents: 362
diff changeset
   922
	    "/
claus
parents: 362
diff changeset
   923
	    "/ we could argue about the following unconditional return:
claus
parents: 362
diff changeset
   924
	    "/ it says that a non pointer array never has a reference to the
claus
parents: 362
diff changeset
   925
	    "/ corresponding object - not mimicing a reference to a copy of the
claus
parents: 362
diff changeset
   926
	    "/ integer. However, it avoids useless searches in huge byteArray
claus
parents: 362
diff changeset
   927
	    "/ like objects when searching for owners. If in doubt, remove it.
claus
parents: 362
diff changeset
   928
	    "/ A consequence of the return below is that #[1 2 3] will say that it
claus
parents: 362
diff changeset
   929
	    "/ does not refer to the number 2 (think of keeping a copy instead)
claus
parents: 362
diff changeset
   930
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   931
	    ^ false.
369
claus
parents: 362
diff changeset
   932
claus
parents: 362
diff changeset
   933
	    "/ alternative:
claus
parents: 362
diff changeset
   934
	    "/  anObject isNumber ifFalse:[^ false].
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   935
	].
369
claus
parents: 362
diff changeset
   936
claus
parents: 362
diff changeset
   937
	"/
claus
parents: 362
diff changeset
   938
	"/ because arrays are so common, and those have a highly tuned
claus
parents: 362
diff changeset
   939
	"/ idenitytIndex method, use it
claus
parents: 362
diff changeset
   940
	"/
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   941
	myClass == Array ifTrue:[
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   942
	    ^ (self identityIndexOf:anObject) ~~ 0
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   943
	].
369
claus
parents: 362
diff changeset
   944
claus
parents: 362
diff changeset
   945
	"/
claus
parents: 362
diff changeset
   946
	"/ otherwise, do it the slow way
claus
parents: 362
diff changeset
   947
	"/
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   948
	numInst := self basicSize.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   949
	1 to:numInst do:[:i | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   950
	    ((self basicAt:i) == anObject) ifTrue:[^ true]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   951
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   952
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   953
    ^ false
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   954
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   955
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   956
     |v|
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   957
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   958
     v := View new initialize.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   959
     v references:Display. 
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
   960
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   961
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   962
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   963
referencesInstanceOf:aClass
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   964
    "return true, if the receiver refers to an instance of
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   965
     the argument, aClass.This method exists
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   966
     to support searching for users of a class."
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   967
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   968
    |myClass 
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   969
     numInst "{ Class: SmallInteger }" |
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   970
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   971
    myClass := self class.
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   972
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   973
    "check the class"
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   974
    (myClass isMemberOf:aClass) ifTrue:[^ true].
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   975
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   976
    "check the instance variables"
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   977
    numInst := myClass instSize.
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   978
    1 to:numInst do:[:i | 
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   979
	((self instVarAt:i) isMemberOf:aClass) ifTrue:[^ true]
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   980
    ].
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   981
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   982
    "check the indexed variables"
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   983
    myClass isVariable ifTrue:[
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   984
	myClass isPointers ifFalse:[
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   985
	    "no need to search in non-pointer indexed fields"
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   986
	    myClass isLongs ifTrue:[
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   987
		(aClass == SmallInteger or:[aClass == LargeInteger]) ifFalse:[^ false].
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   988
	    ] ifFalse:[
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   989
		myClass isFloats ifTrue:[^ aClass == Float].
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   990
		myClass isDoubles ifTrue:[^ aClass == Float].
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   991
		^ aClass == SmallInteger
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   992
	    ]
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   993
	].
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   994
	numInst := self basicSize.
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   995
	1 to:numInst do:[:i | 
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   996
	    ((self basicAt:i) isMemberOf:aClass) ifTrue:[^ true]
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   997
	]
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   998
    ].
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
   999
    ^ false
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1000
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1001
    "
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1002
     (1 @ 3.4) referencesInstanceOf:Float     
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1003
     (1 @ 3.4) referencesInstanceOf:Fraction    
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1004
     View new initialize referencesInstanceOf:(Display class)  
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1005
    "
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1006
!
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1007
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1008
referencesDerivedInstanceOf:aClass
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1009
    "return true, if the receiver refers to an instance of
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1010
     the argument, aClass or its subclass. This method exists
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1011
     to support searching for users of a class."
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1012
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1013
    |myClass 
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1014
     numInst "{ Class: SmallInteger }" |
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1015
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1016
    myClass := self class.
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1017
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1018
    "check the class"
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1019
    (myClass isKindOf:aClass) ifTrue:[^ true].
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1020
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1021
    "check the instance variables"
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1022
    numInst := myClass instSize.
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1023
    1 to:numInst do:[:i | 
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1024
	((self instVarAt:i) isKindOf:aClass) ifTrue:[^ true]
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1025
    ].
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1026
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1027
    "check the indexed variables"
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1028
    myClass isVariable ifTrue:[
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1029
	myClass isPointers ifFalse:[
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1030
	    "no need to search in non pointer fields"
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1031
	    ((aClass == Number) or:[aClass isSubclassOf:Number]) ifFalse:[^ false].
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1032
	].
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1033
	numInst := self basicSize.
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1034
	1 to:numInst do:[:i | 
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1035
	    ((self basicAt:i) isKindOf:aClass) ifTrue:[^ true]
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1036
	]
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1037
    ].
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1038
    ^ false
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1039
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1040
    "
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1041
     (1 @ 3.4) referencesDerivedInstanceOf:Number  
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1042
     (1 @ 3.4) referencesDerivedInstanceOf:Array   
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1043
     View new initialize referencesDerivedInstanceOf:DeviceWorkstation  
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1044
    "
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1045
!
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  1046
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1047
allOwners
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1048
    "return a collection of all objects referencing the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1049
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1050
    ^ ObjectMemory whoReferences:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1051
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1052
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1053
!Object methodsFor:'misc'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1054
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1055
-> anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1056
    "return an association with the receiver as key and
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1057
     the argument as value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1058
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1059
    ^ Association key:self value:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1060
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1061
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1062
!Object methodsFor:'evaluation'!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1063
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1064
value
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1065
    "this allows every object to be used where blocks are typically used.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1066
     Time will show, if this is a good idea or leads to sloppy programming
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1067
     style ... (the idea was borrowed from the Self language).
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1068
     WARNING: dont 'optimize' away ifXXX: blocks - the compilers will 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1069
	      only generate inline code for the if, if the argument(s) are blocks.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1070
	      It will work, but run slower instead."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1071
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1072
    ^ self
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1073
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1074
    "
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1075
     #(1 2 3 4) indexOf:5 ifAbsent:0 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1076
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1077
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1078
    "DO NOT DO THIS (its slower)
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1079
     (1 > 4) ifTrue:'oops' ifFalse:'ok'
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1080
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1081
     USE (the compiler optimizes blocks in if/while):
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1082
     (1 > 4) ifTrue:['oops'] ifFalse:['ok']
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1083
    "
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1084
! !
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1085
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1086
!Object methodsFor:'copying'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1087
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1088
copy
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1089
    "return a copy of the receiver - defaults to shallowcopy here.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1090
     Notice, that copy does not copy dependents."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1091
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1092
    ^ self shallowCopy postCopy
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1093
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1094
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1095
shallowCopyForFinalization
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1096
    "this is used to aquire a copy to be used for finalization -
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1097
     (the copy will get a dispose-notification; see the documentation in the Registry class)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1098
     This method can be redefined for more efficient copying - especially for large objects."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1099
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1100
    ^ self shallowCopy
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1101
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1102
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1103
shallowCopy
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1104
    "return a copy of the object with shared subobjects (a shallow copy)
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1105
     i.e. the copy shares referenced instvars with its original."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1106
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1107
    |myClass aCopy 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1108
     sz "{ Class: SmallInteger }" |
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1109
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1110
    myClass := self class.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1111
    myClass isVariable ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1112
	sz := self basicSize.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1113
	aCopy := myClass basicNew:sz.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1114
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1115
	"copy the indexed variables"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1116
	1 to:sz do:[:i | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1117
	    aCopy basicAt:i put:(self basicAt:i) 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1118
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1119
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1120
	aCopy := myClass basicNew
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1121
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1122
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1123
    "copy the instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1124
    sz := myClass instSize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1125
    1 to:sz do:[:i | 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1126
	aCopy instVarAt:i put:(self instVarAt:i) 
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1127
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1128
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1129
    ^ aCopy
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1130
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1131
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1132
postCopy
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1133
    "this is for compatibility with ST-80 code, which uses postCopy for
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1134
     cleanup after copying, while ST/X passes the original in postCopyFrom:
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1135
     (see there)"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1136
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1137
    ^ self
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1138
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1139
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1140
postCopyFrom:original
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1141
    "sent to a freshly deep-copied object to give it a chance to adjust things.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1142
     (a font could flush its device-handle for example). 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1143
     Notice, that for Sets/Dicts etc. a rehash is not needed, since the deepCopy
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1144
     will have the same hash key as the receiver (as long as ST/X provides the 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1145
     setHash: functionality)."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1146
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1147
    "for ST-80 compatibility, we try postCopy here ..."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1148
    ^ self postCopy
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1149
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1150
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1151
deepCopy
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1152
    "return a copy of the object with all subobjects also copied.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1153
     This method DOES handle cycles/self-refs; however the receivers
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1154
     class is not copied (to avoid the 'total' copy).
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1155
     This deepCopy is a bit slower than the old (unsecure) one, since it
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1156
     keeps track of already copied objects. If you are sure, that your
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1157
     copied object does not include dublicates (or you do not care) and
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1158
     no cycles, you can use the old simpleDeepCopy, which avoids this overhead,
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1159
     but may run into trouble.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1160
     Notice, that copy does not copy dependents."
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1161
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1162
    ^ self deepCopyUsing:(IdentityDictionary new)
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1163
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1164
    "an example which is not handled by the old deepCopy:
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1165
    
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1166
     |a|
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1167
     a := Array new:3.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1168
     a at:3 put:a.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1169
     a deepCopy inspect
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1170
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1171
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1172
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1173
deepCopyError
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1174
    "raise a signal, that deepCopy is not allowed for this object"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1175
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1176
    ^ DeepCopyErrorSignal raise
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1177
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1178
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1179
deepCopyUsing:aDictionary
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1180
    "a helper for deepCopy; return a copy of the object with 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1181
     all subobjects also copied. If the to-be-copied object is in the dictionary, 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1182
     use the value found there. The class of the receiver is not copied.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1183
     This method DOES handle cycles/self references."
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1184
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1185
    |myClass aCopy
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1186
     sz "{ Class: SmallInteger }" 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1187
     iOrig iCopy|
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1188
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1189
    myClass := self class.
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1190
    myClass isVariable ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1191
	sz := self basicSize.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1192
	aCopy := myClass basicNew:sz.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1193
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1194
	sz := 0.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1195
	aCopy := myClass basicNew
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1196
    ].
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1197
    aCopy setHashFrom:self.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1198
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1199
    aDictionary at:self put:aCopy.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1200
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1201
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1202
     copy indexed instvars - if any
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1203
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1204
    sz ~~ 0 ifTrue:[
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1205
	myClass isBits ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1206
	    "block-copy indexed instvars"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1207
	    aCopy replaceFrom:1 to:sz with:self startingAt:1
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1208
	] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1209
	    "individual deep copy the indexed variables"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1210
	    1 to:sz do:[:i | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1211
		iOrig := self basicAt:i.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1212
		iOrig notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1213
		    (aDictionary includesKey:iOrig) ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1214
			iCopy := aDictionary at:iOrig
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1215
		    ] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1216
			iCopy := iOrig deepCopyUsing:aDictionary.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1217
		    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1218
		    aCopy basicAt:i put:iCopy
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1219
		]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1220
	    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1221
	]
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1222
    ].
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1223
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1224
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1225
     copy the instance variables
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1226
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1227
    sz := myClass instSize.
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1228
    sz ~~ 0 ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1229
	1 to:sz do:[:i |
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1230
	    iOrig := self instVarAt:i.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1231
	    iOrig notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1232
		(aDictionary includesKey:iOrig) ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1233
		    iCopy := aDictionary at:iOrig
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1234
		] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1235
		    iCopy := iOrig deepCopyUsing:aDictionary.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1236
		].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1237
		aCopy instVarAt:i put:iCopy
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1238
	    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1239
	].
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1240
    ].
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1241
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1242
    ^ aCopy
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1243
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1244
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1245
simpleDeepCopy
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1246
    "return a copy of the object with all subobjects also copied.
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  1247
     This method does NOT handle cycles - but is included to allow this 
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  1248
     slightly faster copy in situations where it is known that
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  1249
     no recursive references occur (LargeIntegers for example).
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1250
     NOTICE: you will run into trouble, when trying this with recursive
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  1251
     objects (usually recursionInterrupt or memory-alert).
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  1252
     This method corresponds to the 'traditional' deepCopy found in
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  1253
     the Blue book."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1254
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1255
    |myClass aCopy 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1256
     sz "{ Class: SmallInteger }" |
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1257
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1258
    myClass := self class.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1259
    myClass isVariable ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1260
	sz := self basicSize.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1261
	aCopy := myClass basicNew:sz.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1262
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1263
	"copy the indexed variables"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1264
	1 to:sz do:[:i | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1265
	    aCopy basicAt:i put:((self basicAt:i) simpleDeepCopy)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1266
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1267
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1268
	aCopy := myClass basicNew 
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1269
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1270
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1271
    "copy the instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1272
    sz := myClass instSize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1273
    1 to:sz do:[:i | 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1274
	aCopy instVarAt:i put:((self instVarAt:i) simpleDeepCopy)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1275
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1276
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1277
    ^ aCopy
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1278
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1279
    "a bad example (but ST/X should survive ...)"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1280
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1281
     |a|
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1282
     a := Array new:3.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1283
     a at:3 put:a.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1284
     a simpleDeepCopy
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1285
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1286
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1287
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1288
setHashFrom:anObject
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1289
    "set my identity-hash key to be the same as anObjects hash key. 
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1290
     This is an ST/X speciality, which is NOT available in other (especially OT based) 
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1291
     Smalltalks, and may not be available in future ST/X versions.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1292
     DO NEVER use this for normal application code."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1293
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1294
%{  /* NOCONTEXT */
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1295
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1296
    REGISTER unsigned h;
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1297
329
claus
parents: 325
diff changeset
  1298
    if (__isNonNilObject(self) && __isNonNilObject(anObject)) {
375
claus
parents: 370
diff changeset
  1299
	h = __GET_HASH(anObject);
claus
parents: 370
diff changeset
  1300
	__SET_HASH(self, h);
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1301
	RETURN (self);
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1302
    }
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1303
%}
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1304
.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1305
    self primitiveFailed    "neither receiver not arg may be nil or SmallInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1306
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1307
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1308
!Object methodsFor:'comparing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1309
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1310
== anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1311
    "return true, if the receiver and the arg are the same object"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1312
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1313
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1314
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1315
    RETURN ( (self == anObject) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1316
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1317
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1318
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1319
~~ anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1320
    "return true, if the receiver and the arg are not the same object"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1321
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1322
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1323
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1324
    RETURN ( (self == anObject) ? false : true );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1325
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1326
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1327
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1328
= anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1329
    "return true, if the receiver and the arg have the same structure"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1330
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1331
    ^ self == anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1332
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1333
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1334
~= anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1335
    "return true, if the receiver and the arg do not have the same structure"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1336
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1337
    ^ (self = anObject) not
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1338
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1339
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1340
isNil
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1341
    "return true, if the receiver is nil"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1342
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1343
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1344
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1345
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1346
notNil
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1347
    "return true, if the receiver is not nil"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1348
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1349
    ^ true
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1350
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1351
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1352
hash
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1353
    "return an Integer useful as a hash key for the receiver.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1354
     This hash should return same values for objects with same
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1355
     contents (i.e. use this to hash on structure)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1356
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1357
    ^ self identityHash
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1358
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1359
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1360
identityHash
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1361
    "return an Integer useful as a hash key for the receiver.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1362
     This hash should return same values for the same object (i.e. use
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1363
     this to hash on identity of objects).
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1364
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1365
     We cannot use the Objects address (as other smalltalks do) since
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1366
     no object-table exists and the hashval must not change when objects
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1367
     are moved by the collector. Therefore we assign each object a unique
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1368
     Id in the object header itself as its hashed upon.
370
claus
parents: 369
diff changeset
  1369
     (luckily we have 11 bits spare to do this - unluckily its only 11 bits).
claus
parents: 369
diff changeset
  1370
     Time will show, if 11 bits are enough; if not, another entry in the
2
claus
parents: 1
diff changeset
  1371
     object header will be needed, adding 4 bytes to every object. Alternatively,
claus
parents: 1
diff changeset
  1372
     hashed-upon objects could add an instvar containing the hash value."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1373
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1374
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1375
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1376
    REGISTER unsigned hash;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1377
    static unsigned nextHash = 0;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1378
    OBJ cls;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1379
329
claus
parents: 325
diff changeset
  1380
    if (__isNonNilObject(self)) {
375
claus
parents: 370
diff changeset
  1381
	hash = __GET_HASH(self);
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1382
	if (hash == 0) {
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1383
	    hash = nextHash++;
375
claus
parents: 370
diff changeset
  1384
	    __SET_HASH(self, hash);
claus
parents: 370
diff changeset
  1385
	    hash = __GET_HASH(self);
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1386
	    if (hash == 0) {
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1387
		hash = nextHash++;
375
claus
parents: 370
diff changeset
  1388
		__SET_HASH(self, hash);
claus
parents: 370
diff changeset
  1389
		hash = __GET_HASH(self);
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1390
	    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1391
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1392
359
claus
parents: 357
diff changeset
  1393
	/*
370
claus
parents: 369
diff changeset
  1394
	 * now, we got 11 bits for hashing;
359
claus
parents: 357
diff changeset
  1395
	 * make it as large as possible; since most hashers use the returned
claus
parents: 357
diff changeset
  1396
	 * key and take it modulu some prime number, this will allow for
claus
parents: 357
diff changeset
  1397
	 * better distribution (i.e. bigger empty spaces) in hashed collection.
claus
parents: 357
diff changeset
  1398
	 * we could shift it up to the 30 bit limit - not making it negative.
claus
parents: 357
diff changeset
  1399
	 */
370
claus
parents: 369
diff changeset
  1400
	RETURN ( _MKSMALLINT(hash << __HASH_SHIFT__) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1401
    }
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1402
%}.
356
claus
parents: 348
diff changeset
  1403
    ^ 0 "never reached, since redefined in UndefinedObject and SmallInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1404
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1405
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1406
!Object methodsFor:'interrupt handling'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1407
2
claus
parents: 1
diff changeset
  1408
internalError:msg
claus
parents: 1
diff changeset
  1409
    "this is triggered, when system hits some bad error,
claus
parents: 1
diff changeset
  1410
     such as corrupted class, corrupted method/selector array
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  1411
     etc. The argument string gives some more information on what happened.
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  1412
     (for example, if you set an objects class to a smallInteger, nil etc). 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1413
     Its not guaranteed, that the system is in a working condition once
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1414
     this error occurred ...."
2
claus
parents: 1
diff changeset
  1415
85
claus
parents: 77
diff changeset
  1416
    ^ self error:msg
2
claus
parents: 1
diff changeset
  1417
!
claus
parents: 1
diff changeset
  1418
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1419
userInterrupt
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1420
    "user (^c) interrupt - enter debugger"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1421
10
claus
parents: 5
diff changeset
  1422
    UserInterruptSignal raise
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1423
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1424
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1425
ioInterrupt
10
claus
parents: 5
diff changeset
  1426
    "I/O (SIGIO/SIGPOLL) interrupt and no handler - enter debugger"
claus
parents: 5
diff changeset
  1427
claus
parents: 5
diff changeset
  1428
    self error:'I/O Interrupt - but no handler'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1429
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1430
2
claus
parents: 1
diff changeset
  1431
childSignalInterrupt
claus
parents: 1
diff changeset
  1432
    "death of a child process (unix process) - do nothing"
claus
parents: 1
diff changeset
  1433
claus
parents: 1
diff changeset
  1434
    ^ self
claus
parents: 1
diff changeset
  1435
!
claus
parents: 1
diff changeset
  1436
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1437
spyInterrupt
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1438
    "spy interrupt and no handler - enter debugger"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1439
10
claus
parents: 5
diff changeset
  1440
    self error:'spy Interrupt - but no handler'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1441
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1442
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1443
timerInterrupt
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1444
    "timer interrupt and no handler - enter debugger"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1445
10
claus
parents: 5
diff changeset
  1446
    self error:'timer Interrupt - but no handler'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1447
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1448
375
claus
parents: 370
diff changeset
  1449
errorInterrupt:errorID with:aParameter
claus
parents: 370
diff changeset
  1450
    "subsystem error. The arguments errorID and aParameter are the values passed
claus
parents: 370
diff changeset
  1451
     to the 'errorInterruptWithIDAndParameter(id, param)' function, 
claus
parents: 370
diff changeset
  1452
     which can be called from C subsystems to raise an (asynchronous)
claus
parents: 370
diff changeset
  1453
     error exception.
345
claus
parents: 343
diff changeset
  1454
claus
parents: 343
diff changeset
  1455
     Currently, this is used to map XErrors to smalltalk errors, but can be
375
claus
parents: 370
diff changeset
  1456
     used from other C subsystems too, to upcast errors.
claus
parents: 370
diff changeset
  1457
     Especially, for subsystems which call errorHandler functions asynchronously.
345
claus
parents: 343
diff changeset
  1458
     IDs (currently) used:
claus
parents: 343
diff changeset
  1459
	#DisplayError ..... x-error interrupt
348
claus
parents: 345
diff changeset
  1460
	#XtError      ..... xt-error interrupt (Xt interface is not yet published)
345
claus
parents: 343
diff changeset
  1461
    "
claus
parents: 343
diff changeset
  1462
claus
parents: 343
diff changeset
  1463
    |handler|
claus
parents: 343
diff changeset
  1464
claus
parents: 343
diff changeset
  1465
    handler := ObjectMemory registeredErrorInterruptHandlers at:errorID ifAbsent:nil.
claus
parents: 343
diff changeset
  1466
    handler notNil ifTrue:[
375
claus
parents: 370
diff changeset
  1467
	"/
claus
parents: 370
diff changeset
  1468
	"/ handler found; let it do whatever it wants ...
claus
parents: 370
diff changeset
  1469
	"/
claus
parents: 370
diff changeset
  1470
	handler errorInterrupt:errorID with:aParameter.
345
claus
parents: 343
diff changeset
  1471
	^ self
claus
parents: 343
diff changeset
  1472
    ].
claus
parents: 343
diff changeset
  1473
375
claus
parents: 370
diff changeset
  1474
    "/
claus
parents: 370
diff changeset
  1475
    "/ no handler - raise errorSignal passing the errorId as parameter
claus
parents: 370
diff changeset
  1476
    "/
345
claus
parents: 343
diff changeset
  1477
    ^ ErrorSignal 
claus
parents: 343
diff changeset
  1478
	raiseRequestWith:errorID 
claus
parents: 343
diff changeset
  1479
	errorString:('Subsystem error. ErrorID = ' , errorID printString)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1480
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1481
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1482
memoryInterrupt
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1483
    "out-of-memory interrupt and no handler - enter debugger"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1484
345
claus
parents: 343
diff changeset
  1485
    ^ self error:'almost out of memory'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1486
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1487
387
claus
parents: 384
diff changeset
  1488
customInterrupt
claus
parents: 384
diff changeset
  1489
    "a custom interrupt"
claus
parents: 384
diff changeset
  1490
claus
parents: 384
diff changeset
  1491
    ^ self error:'custom interrupt'
claus
parents: 384
diff changeset
  1492
!
claus
parents: 384
diff changeset
  1493
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1494
fpExceptionInterrupt
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1495
    "a floating point exception occured - this one
113
0403779c8fe3 return value of signal raise;
claus
parents: 110
diff changeset
  1496
     has to be handled differently since it comes asynchronous
213
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1497
     on some machines (for example, on machines with a separate FPU
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1498
     or superscalar architectures. Also, errors from within primitive code
113
0403779c8fe3 return value of signal raise;
claus
parents: 110
diff changeset
  1499
     (or library functions such as GL) are sent via the Unix-signal
0403779c8fe3 return value of signal raise;
claus
parents: 110
diff changeset
  1500
     mechanism this way."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1501
113
0403779c8fe3 return value of signal raise;
claus
parents: 110
diff changeset
  1502
    ^ Float domainErrorSignal raise
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1503
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1504
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1505
signalInterrupt:signalNumber
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1506
    "unix signal occured - some signals are handled as Smalltalk Exceptions 
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1507
     (SIGPIPE), others (SIGBUS) are rather fatal ...
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1508
     In any case, if a smalltalk-signal has been connected to the OS signal,
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1509
     that one is raised.
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1510
     TODO: add another argument, giving more detailed signal info (PC, VADDR,
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1511
     exact cause etc.). This helps if segvs occur in primitive code.
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1512
     Currently (temporary kludge), these are passed as global variables."
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1513
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1514
    |box name here sig ignorable titles actions badContext msg pc addr|
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1515
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1516
    "
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1517
     special case - since SIGPIPE has an ST-signal associated
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1518
    "
2
claus
parents: 1
diff changeset
  1519
    (signalNumber == 13) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1520
	"SIGPIPE - write on a pipe with no one to read"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1521
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1522
	^ PipeStream brokenPipeSignal raise.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1523
    ].
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1524
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1525
    "if there has been an ST-signal installed, use it ..."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1526
113
0403779c8fe3 return value of signal raise;
claus
parents: 110
diff changeset
  1527
    sig := OperatingSystem operatingSystemSignal:signalNumber.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1528
    sig notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1529
	^ sig raise
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1530
    ].
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1531
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1532
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1533
     ... otherwise , bring up a box asking for what to do ...
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1534
    "
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  1535
    name := OperatingSystem nameForSignal:signalNumber.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1536
    here := thisContext.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1537
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1538
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1539
     the context, in which the signal occurred:
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1540
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1541
    badContext := here sender.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1542
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1543
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1544
     ungrab - in case it happened in a box/popupview
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1545
     otherwise display stays locked
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1546
    "
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1547
    Display notNil ifTrue:[
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1548
	Display ungrabPointer.
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1549
    ].
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1550
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1551
    "
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1552
     SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1553
     since the system will retry the faulty instruction, which leads to
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1554
     another signal - to avoid frustration, better not offer this option.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1555
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1556
    ignorable := (signalNumber ~~ OperatingSystem sigBUS)
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1557
		  and:[signalNumber ~~ OperatingSystem sigILL
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1558
		  and:[signalNumber ~~ OperatingSystem sigSEGV]].
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1559
110
7093adf38df2 check for recursive signal
claus
parents: 102
diff changeset
  1560
    ignorable ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1561
	here isRecursive ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1562
	    'fatal: signal ' errorPrint. signalNumber errorPrintNL.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1563
	    MiniDebugger enterWithMessage:'recursive signal'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1564
	    ^ self
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1565
	].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1566
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1567
	 a hard signal - go into debugger immediately
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1568
	"
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1569
	msg := 'Signal ', name.
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1570
	InterruptPcLow notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1571
	    pc := InterruptPcLow + (InterruptPcHi bitShift:16).
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1572
	    pc ~~ 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1573
		msg := msg , ' PC=' , (pc printStringRadix:16)
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1574
	    ].
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1575
	].
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1576
	InterruptAddrLow notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1577
	    addr := InterruptAddrLow + (InterruptAddrHi bitShift:16).
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1578
	    addr ~~ 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1579
		msg := msg , ' ADDR=' , (addr printStringRadix:16)
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1580
	    ].
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1581
	].
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  1582
	Debugger enter:here withMessage:msg. 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1583
	badContext return.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1584
	^ nil.
110
7093adf38df2 check for recursive signal
claus
parents: 102
diff changeset
  1585
    ].
7093adf38df2 check for recursive signal
claus
parents: 102
diff changeset
  1586
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1587
    OptionBox isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1588
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1589
	 a system without GUI ...
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1590
	 go into minidebugger (if there is one)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1591
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1592
	MiniDebugger isNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1593
	    "
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1594
	     a system without debugging facilities
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1595
	     (i.e. a standalone system)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1596
	     output a message and exit.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1597
	    "
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1598
	    ('exit due to Signal ' , name) errorPrintNL.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1599
	    Smalltalk exit.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1600
	].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1601
	MiniDebugger enterWithMessage:'Signal cought (' , name, ')'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1602
	^ self
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1603
    ].
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1604
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1605
    box := OptionBox 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1606
		title:'Signal cought (' , name, ')'
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1607
		numberOfOptions:(ignorable ifTrue:[5] ifFalse:[4]).
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1608
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1609
    titles := #('return' 'debug' 'dump' 'exit').
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1610
    actions := Array 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1611
		 with:[badContext return]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1612
		 with:[Debugger enter:here withMessage:('Signal ', name). ^nil]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1613
		 with:[Smalltalk fatalAbort]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1614
		 with:[Smalltalk exit].
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1615
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1616
    ignorable ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1617
	titles := #('ignore') , titles.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1618
	actions := (Array with:[^ nil]) , actions.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1619
    ].
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1620
    box buttonTitles:titles.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1621
    box actions:actions.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1622
    box showAtPointer
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1623
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1624
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1625
recursionInterrupt
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1626
    "recursion limit (actually: stack overflow) interrupt.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1627
     This interrupt is triggered, when a process stack grows above
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1628
     its stackLimit - usually, this leads into the debugger, but
213
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1629
     could be cought and the stackLimit increased in the handler.
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1630
     At the time we arrive here, the system has still some stack 
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1631
     as a reserve so we can continue to do some useful work or cleanup or
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1632
     debugging for a while.
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1633
     If the signal is ignored, and the stack continues to grow, there
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1634
     will be a few more chances (and more interrupts) before the VM
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1635
     hard-terminates the process."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1636
33
50cf0f6bc0ad *** empty log message ***
claus
parents: 27
diff changeset
  1637
    thisContext isRecursive ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1638
	^ RecursionInterruptSignal raise
33
50cf0f6bc0ad *** empty log message ***
claus
parents: 27
diff changeset
  1639
    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1640
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1641
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1642
exceptionInterrupt
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1643
    "exception interrupt - enter debugger"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1644
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1645
    self error:'exception Interrupt'
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1646
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1647
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1648
!Object methodsFor:'error handling'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1649
2
claus
parents: 1
diff changeset
  1650
subscriptBoundsError
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1651
    "report error that some index is out of bounds.
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1652
     (when accessing indexable collections)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1653
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1654
    ^ SubscriptOutOfBoundsSignal raiseIn:thisContext sender
2
claus
parents: 1
diff changeset
  1655
!
claus
parents: 1
diff changeset
  1656
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1657
subscriptBoundsError:anIndex
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1658
    "report error that anIndex is out of bounds.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1659
     (when accessing indexable collections)"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1660
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1661
    ^ SubscriptOutOfBoundsSignal raiseRequestWith:anIndex in:thisContext sender
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1662
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1663
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1664
indexNotInteger
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1665
    "report error that index is not an Integer.
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1666
     (when accessing collections indexed by an integer key)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1667
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1668
    ^ NonIntegerIndexSignal raiseIn:thisContext sender
2
claus
parents: 1
diff changeset
  1669
!
claus
parents: 1
diff changeset
  1670
claus
parents: 1
diff changeset
  1671
errorNotFound
345
claus
parents: 343
diff changeset
  1672
    "report error that no element was found in a collection"
2
claus
parents: 1
diff changeset
  1673
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1674
    ^ NotFoundSignal raiseIn:thisContext sender
2
claus
parents: 1
diff changeset
  1675
!
claus
parents: 1
diff changeset
  1676
345
claus
parents: 343
diff changeset
  1677
errorKeyNotFound:aKey
2
claus
parents: 1
diff changeset
  1678
    "report error that a key was not found in a collection"
claus
parents: 1
diff changeset
  1679
345
claus
parents: 343
diff changeset
  1680
    ^ KeyNotFoundSignal raiseRequestWith:aKey in:thisContext sender
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1681
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1682
10
claus
parents: 5
diff changeset
  1683
elementBoundsError
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1684
    "report error that badElement is out of bounds 
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1685
     (i.e. cannot be put into that collection)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1686
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1687
    ^ ElementOutOfBoundsSignal raiseIn:thisContext sender
10
claus
parents: 5
diff changeset
  1688
!
claus
parents: 5
diff changeset
  1689
claus
parents: 5
diff changeset
  1690
elementNotInteger
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1691
    "report error that object to be stored is not Integer.
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1692
     (in collections that store integers only)"
10
claus
parents: 5
diff changeset
  1693
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1694
    ^ ElementOutOfBoundsSignal raiseIn:thisContext sender
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1695
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1696
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1697
elementNotCharacter
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1698
    "report error that object to be stored is no Character.
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1699
     (usually when storing into Strings)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1700
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1701
    ^ ElementOutOfBoundsSignal raiseIn:thisContext sender
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1702
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1703
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1704
mustBeRectangle
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1705
    "report an argument-not-rectangle-error"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1706
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1707
    ^ self error:'argument must be a Rectangle'
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1708
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1709
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1710
mustBeString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1711
    "report an argument-not-string-error"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1712
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1713
    ^ self error:'argument must be a String'
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1714
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1715
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1716
notIndexed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1717
    "report error that receiver has no indexed instance variables"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1718
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1719
    ^ self error:'receiver has no indexed variables'
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1720
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1721
2
claus
parents: 1
diff changeset
  1722
integerCheckError
claus
parents: 1
diff changeset
  1723
    "generated when a variable declared with an integer type gets a bad
claus
parents: 1
diff changeset
  1724
     value assigned"
claus
parents: 1
diff changeset
  1725
claus
parents: 1
diff changeset
  1726
    ^ self error:'bad assign of ' , self printString , 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1727
		  ' (' , self class name , ') to integer-typed variable'
2
claus
parents: 1
diff changeset
  1728
!
claus
parents: 1
diff changeset
  1729
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1730
typeCheckError
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1731
    "generated when a variable declared with a type hint gets a bad
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1732
     value assigned"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1733
2
claus
parents: 1
diff changeset
  1734
    ^ self error:'bad assign of ' , self printString ,
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1735
		  ' (' , self class name , ') to typed variable'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1736
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1737
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1738
primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1739
    "report error that primitive code failed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1740
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1741
    ^ PrimitiveFailureSignal raiseIn:(thisContext sender)
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1742
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1743
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1744
implementedBySubclass
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1745
    "this is sent by ST/V code - its the same as #subclassResponsibility"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1746
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1747
    ^ self subclassResponsibility
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1748
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1749
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1750
invalidMessage 
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1751
    "this is sent by ST/V code - its the same as #shouldNotImplement"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1752
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1753
    ^ self shouldNotImplement
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1754
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1755
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1756
subclassResponsibility
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1757
    "report error that this message should have been reimplemented in a
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1758
     subclass"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1759
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1760
    ^ self error:'method must be reimplemented in subclass'
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1761
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1762
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1763
shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1764
    "report error that this message should not be implemented"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1765
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1766
    ^ self error:'method not appropriate for this class'
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1767
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1768
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1769
halt
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1770
    "enter debugger with halt-message"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1771
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1772
    ^ HaltSignal raiseIn:thisContext sender.
27
d98f9dd437f7 *** empty log message ***
claus
parents: 25
diff changeset
  1773
!
d98f9dd437f7 *** empty log message ***
claus
parents: 25
diff changeset
  1774
d98f9dd437f7 *** empty log message ***
claus
parents: 25
diff changeset
  1775
halt:aString
d98f9dd437f7 *** empty log message ***
claus
parents: 25
diff changeset
  1776
    "enter debugger with halt-message"
d98f9dd437f7 *** empty log message ***
claus
parents: 25
diff changeset
  1777
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1778
    ^ HaltSignal raiseRequestWith:#halt: 
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1779
		      errorString:aString
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1780
			       in:thisContext sender
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1781
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1782
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1783
error
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1784
    "report error that an error occured"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1785
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1786
    ^ ErrorSignal raiseIn:thisContext sender 
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1787
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1788
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1789
error:aString
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1790
    "enter debugger with error-message aString"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1791
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1792
    ^ ErrorSignal raiseRequestWith:#error: 
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1793
		       errorString:aString
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1794
				in:thisContext sender
2
claus
parents: 1
diff changeset
  1795
!
claus
parents: 1
diff changeset
  1796
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1797
doesNotUnderstand:aMessage
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1798
    "this message is sent by the runtime system (VM) when
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1799
     a message is not understood by some object (i.e. there
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1800
     is no method for that selector). The original message has
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1801
     been packed into aMessage (i.e. the receiver, selector and
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1802
     any arguments) and the original receiver is then sent the
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1803
     #doesNotUnderstand: message.
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1804
     Here, we raise another signal which usually enters the debugger.
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1805
     You can of course redefine #doesNotUnderstand: in your classes
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1806
     to implement message delegation."
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1807
359
claus
parents: 357
diff changeset
  1808
    |sel errorString cls sender|
claus
parents: 357
diff changeset
  1809
claus
parents: 357
diff changeset
  1810
    (sel := aMessage selector) isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1811
	"happens when things go mad, or a method has been
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1812
	 called by valueWithReceiver: with a wrong receiver"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1813
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1814
	sel := '(nil)'
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1815
    ].
403
claus
parents: 397
diff changeset
  1816
"/    Smalltalk isInitialized ifFalse:[
421
claus
parents: 403
diff changeset
  1817
"/      sel printNL
403
claus
parents: 397
diff changeset
  1818
"/    ].
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1819
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1820
    "the new errorString gives more information ..."
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1821
"/    errorString := 'Message not understood: ' , sel.
359
claus
parents: 357
diff changeset
  1822
    sender := thisContext sender.
claus
parents: 357
diff changeset
  1823
    cls := sender searchClass.
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  1824
    cls isNil ifTrue:[
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  1825
	"it was NOT a super or directed send ..."
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  1826
	cls := self class
314
7581a5c57224 *** empty log message ***
claus
parents: 308
diff changeset
  1827
    ].
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  1828
    errorString := cls name , ' does not understand: ' , sel.
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1829
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1830
    "
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1831
     this only happens, when YOU play around with my classvars ...
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1832
    "
85
claus
parents: 77
diff changeset
  1833
    MessageNotUnderstoodSignal isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1834
	^ self enterDebuggerWith:nil
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1835
			 message:'oops - MessageNotUnderstoodSignal is gone'.
85
claus
parents: 77
diff changeset
  1836
    ].
113
0403779c8fe3 return value of signal raise;
claus
parents: 110
diff changeset
  1837
    ^ MessageNotUnderstoodSignal
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1838
		raiseRequestWith:aMessage
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1839
		     errorString:errorString
359
claus
parents: 357
diff changeset
  1840
			      in:sender
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1841
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1842
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1843
appropriateDebugger:aSelector
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1844
    "return an appropriate debugger to use.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1845
     If there is already a debugger active on the stack, and it is
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1846
     the DebugView, return MiniDebugger (as a last chance) otherwise abort."
85
claus
parents: 77
diff changeset
  1847
claus
parents: 77
diff changeset
  1848
    |context|
claus
parents: 77
diff changeset
  1849
claus
parents: 77
diff changeset
  1850
    context := thisContext.
claus
parents: 77
diff changeset
  1851
    context := context sender.
claus
parents: 77
diff changeset
  1852
    [context notNil] whileTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1853
	((context receiver class == Debugger) 
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1854
	 and:[context selector == aSelector]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1855
	    "we are already in some Debugger"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1856
	    (Debugger == MiniDebugger) ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1857
		"we are already in the MiniDebugger"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1858
		ErrorRecursion ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1859
		    Smalltalk fatalAbort:'recursive error ...'
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1860
		]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1861
	    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1862
	    MiniDebugger isNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1863
		Smalltalk fatalAbort:'no debugger'
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1864
	    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1865
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1866
	    "ok, an error occured while in the graphical debugger;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1867
	     lets try MiniDebugger"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1868
	    ^ MiniDebugger
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1869
	].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1870
	context := context sender
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1871
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1872
    "not within Debugger - no problem"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1873
    ^ Debugger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1874
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1875
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1876
enterDebuggerWith:anException message:aString
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1877
    "enter the debugger with error-message aString"
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1878
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1879
    ^ self enterDebuggerWith:anException 
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1880
		     message:aString 
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1881
			   on:anException suspendedContext
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1882
!
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1883
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1884
enterDebuggerWith:anException message:aString on:aContext 
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1885
    "enter the debugger with error-message aString.
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1886
     The first visible context shown there is aContext 
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1887
     (this allows intermediate helpers to hide themselfes from what is
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1888
     presented to the user)"
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1889
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1890
    |debugger|
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1891
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1892
    "
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1893
     if there is no debugger, exit smalltalk
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1894
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1895
    Debugger isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1896
	'error: ' errorPrint. aString errorPrintNL.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1897
	Smalltalk fatalAbort:'no Debugger defined'
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1898
    ].
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1899
    "
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1900
     find an appropriate debugger to use
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  1901
    "
255
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1902
    debugger := self appropriateDebugger:#'enter:withMessage:'.
2b2c5c0facab *** empty log message ***
claus
parents: 253
diff changeset
  1903
    ^ debugger enter:aContext withMessage:aString.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1904
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1905
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1906
!Object methodsFor:'debugging'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1907
342
claus
parents: 340
diff changeset
  1908
obsoleteMethodWarning:message from:aContext
260
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1909
    "in methods which are going to be obsoleted, a self send to
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1910
     this method is used to tell programmers that a method is
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1911
     used which is going to be removed in later ST/X versions.
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1912
     Find all methods which will be obsolete soon by looking at senders
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1913
     of this."
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1914
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1915
    |m spec w|
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1916
342
claus
parents: 340
diff changeset
  1917
    m := aContext method.
260
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1918
    spec := m displayString.
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1919
    m notNil ifTrue:[
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1920
	w := m who.
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1921
	w notNil ifTrue:[
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1922
	    spec := (w at:1) name , '>>' , (w at:2)
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1923
	]
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1924
    ].
340
claus
parents: 339
diff changeset
  1925
    ('WARNING: the ''' , spec , ''' method is obsolete.') errorPrintNL.
claus
parents: 339
diff changeset
  1926
    ('         And may not be present in future ST/X versions.') errorPrintNL.
342
claus
parents: 340
diff changeset
  1927
    ('         called from ' , aContext sender printString) errorPrintNL.
340
claus
parents: 339
diff changeset
  1928
    message notNil ifTrue:[
claus
parents: 339
diff changeset
  1929
	'------>  ' errorPrint. message errorPrintNL
claus
parents: 339
diff changeset
  1930
    ]
claus
parents: 339
diff changeset
  1931
!
claus
parents: 339
diff changeset
  1932
342
claus
parents: 340
diff changeset
  1933
obsoleteMethodWarning:message
claus
parents: 340
diff changeset
  1934
    "in methods which are going to be obsoleted, a self send to
claus
parents: 340
diff changeset
  1935
     this method is used to tell programmers that a method is
claus
parents: 340
diff changeset
  1936
     used which is going to be removed in later ST/X versions.
claus
parents: 340
diff changeset
  1937
     Find all methods which will be obsolete soon by looking at senders
claus
parents: 340
diff changeset
  1938
     of this."
claus
parents: 340
diff changeset
  1939
claus
parents: 340
diff changeset
  1940
    self obsoleteMethodWarning:message from:thisContext sender
claus
parents: 340
diff changeset
  1941
!
claus
parents: 340
diff changeset
  1942
340
claus
parents: 339
diff changeset
  1943
obsoleteMethodWarning
claus
parents: 339
diff changeset
  1944
    "in methods which are going to be obsoleted, a self send to
claus
parents: 339
diff changeset
  1945
     this method is used to tell programmers that a method is
claus
parents: 339
diff changeset
  1946
     used which is going to be removed in later ST/X versions.
claus
parents: 339
diff changeset
  1947
     Find all methods which will be obsolete soon by looking at senders
claus
parents: 339
diff changeset
  1948
     of this."
claus
parents: 339
diff changeset
  1949
342
claus
parents: 340
diff changeset
  1950
    self obsoleteMethodWarning:nil from:thisContext sender
260
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1951
!
cefb485445a7 *** empty log message ***
claus
parents: 259
diff changeset
  1952
325
claus
parents: 324
diff changeset
  1953
mustBeKindOf:aClass
claus
parents: 324
diff changeset
  1954
    "for compatibility & debugging support: 
claus
parents: 324
diff changeset
  1955
     check if the receiver isKindOf:aClass and raise an error if not.
claus
parents: 324
diff changeset
  1956
     Notice:
claus
parents: 324
diff changeset
  1957
	it is VERY questionable, if it makes sense to add manual
claus
parents: 324
diff changeset
  1958
	type checks to a dynamically typed language like smalltalk. 
claus
parents: 324
diff changeset
  1959
	It will, at least, slow down performance,
claus
parents: 324
diff changeset
  1960
	make your code less reusable and clutter your code with stupid sends
claus
parents: 324
diff changeset
  1961
	of this selector. Also, read the comment in isKindOf:, regarding the
claus
parents: 324
diff changeset
  1962
	use of isXXX check methods.
claus
parents: 324
diff changeset
  1963
     You see: The author does not like this at all ..."
claus
parents: 324
diff changeset
  1964
claus
parents: 324
diff changeset
  1965
    (self isKindOf:aClass) ifFalse:[
claus
parents: 324
diff changeset
  1966
	self error:'argument is not of expected type'
claus
parents: 324
diff changeset
  1967
    ]
claus
parents: 324
diff changeset
  1968
!
claus
parents: 324
diff changeset
  1969
397
claus
parents: 387
diff changeset
  1970
errorNotify:aString
claus
parents: 387
diff changeset
  1971
    "launch a Notifier, showing top stack, telling user something
362
claus
parents: 359
diff changeset
  1972
     and give a chance to enter debugger."
claus
parents: 359
diff changeset
  1973
369
claus
parents: 362
diff changeset
  1974
    |info con sender|
362
claus
parents: 359
diff changeset
  1975
claus
parents: 359
diff changeset
  1976
    Dialog isNil ifTrue:[
claus
parents: 359
diff changeset
  1977
	"
claus
parents: 359
diff changeset
  1978
	 on systems without GUI, simply show
claus
parents: 359
diff changeset
  1979
	 the message on the Transcript.
claus
parents: 359
diff changeset
  1980
	"
claus
parents: 359
diff changeset
  1981
	Transcript showCr:aString.
claus
parents: 359
diff changeset
  1982
	^ self
claus
parents: 359
diff changeset
  1983
    ].
claus
parents: 359
diff changeset
  1984
    Dialog autoload.        "in case its autoloaded"
claus
parents: 359
diff changeset
  1985
369
claus
parents: 362
diff changeset
  1986
    con := sender := thisContext sender.
362
claus
parents: 359
diff changeset
  1987
    info := aString , Character cr asString , Character cr asString.
claus
parents: 359
diff changeset
  1988
    1 to:5 do:[:n |
claus
parents: 359
diff changeset
  1989
	con notNil ifTrue:[
claus
parents: 359
diff changeset
  1990
	    info := info , con printString , Character cr asString.
claus
parents: 359
diff changeset
  1991
	    con := con sender
claus
parents: 359
diff changeset
  1992
	]
claus
parents: 359
diff changeset
  1993
    ].
claus
parents: 359
diff changeset
  1994
claus
parents: 359
diff changeset
  1995
    (Dialog choose:info 
claus
parents: 359
diff changeset
  1996
	   labels:#('proceed' 'debug')
claus
parents: 359
diff changeset
  1997
	   values:#(#proceed #debug)
claus
parents: 359
diff changeset
  1998
	   default:#debug) == #debug
claus
parents: 359
diff changeset
  1999
    ifTrue:[
369
claus
parents: 362
diff changeset
  2000
	Debugger enter:sender withMessage:aString
362
claus
parents: 359
diff changeset
  2001
    ]
claus
parents: 359
diff changeset
  2002
claus
parents: 359
diff changeset
  2003
    "
397
claus
parents: 387
diff changeset
  2004
     nil errorNotify:'hello there'
claus
parents: 387
diff changeset
  2005
     self errorNotify:'hello there'
claus
parents: 387
diff changeset
  2006
    "
claus
parents: 387
diff changeset
  2007
!
claus
parents: 387
diff changeset
  2008
claus
parents: 387
diff changeset
  2009
notify:aString
claus
parents: 387
diff changeset
  2010
    "launch a Notifier, telling user something"
claus
parents: 387
diff changeset
  2011
claus
parents: 387
diff changeset
  2012
    Dialog isNil ifTrue:[
claus
parents: 387
diff changeset
  2013
	"
claus
parents: 387
diff changeset
  2014
	 on systems without GUI, simply show
claus
parents: 387
diff changeset
  2015
	 the message on the Transcript.
claus
parents: 387
diff changeset
  2016
	"
claus
parents: 387
diff changeset
  2017
	Transcript showCr:aString.
claus
parents: 387
diff changeset
  2018
	^ self
claus
parents: 387
diff changeset
  2019
    ].
claus
parents: 387
diff changeset
  2020
    Dialog autoload.        "in case its autoloaded"
claus
parents: 387
diff changeset
  2021
    Dialog information:aString
claus
parents: 387
diff changeset
  2022
claus
parents: 387
diff changeset
  2023
    "
362
claus
parents: 359
diff changeset
  2024
     nil notify:'hello there'
claus
parents: 359
diff changeset
  2025
     self notify:'hello there'
claus
parents: 359
diff changeset
  2026
    "
claus
parents: 359
diff changeset
  2027
!
claus
parents: 359
diff changeset
  2028
claus
parents: 359
diff changeset
  2029
information:aString
claus
parents: 359
diff changeset
  2030
    "launch an InfoBox, telling user something"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2031
298
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2032
    Dialog isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2033
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2034
	 on systems without GUI, simply show
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2035
	 the message on the Transcript.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2036
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2037
	Transcript showCr:aString.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2038
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2039
    ].
298
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2040
    Dialog autoload.        "in case its autoloaded"
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2041
    Dialog information:aString
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2042
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2043
    "
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2044
     nil information:'hello there'
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2045
     self information:'hello there'
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2046
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2047
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2048
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2049
warn:aString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2050
    "launch a WarningBox, telling user something"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2051
298
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2052
    Dialog isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2053
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2054
	 on systems without GUI, simply show
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2055
	 the message on the Transcript.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2056
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2057
	Transcript showCr:aString.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2058
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2059
    ].
298
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2060
    Dialog autoload.        "in case its autoloaded"
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2061
    Dialog warn:aString
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2062
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2063
    "
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2064
     nil warn:'hello there'
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2065
     self warn:'hello there'
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2066
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2067
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2068
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2069
confirm:aString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2070
    "launch a confirmer, which allows user to enter yes or no.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2071
     return true for yes, false for no"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2072
298
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2073
    Dialog isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2074
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2075
	 on systems without GUI, output a message
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2076
	 and return true (as if yes was answered)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2077
	 Q: should we ask user by reading Stdin ?
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2078
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2079
	Transcript showCr:aString.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2080
	Transcript showCr:'continue, assuming <yes>'.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2081
	^ true
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2082
    ].
298
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2083
    Dialog autoload.        "in case its autoloaded"
962712d27c2d *** empty log message ***
claus
parents: 293
diff changeset
  2084
    ^ Dialog confirm:aString
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2085
        
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2086
    "
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2087
     nil confirm:'hello'
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2088
     self confirm:'hello'
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2089
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2090
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2091
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2092
basicInspect
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2093
    "launch an inspector on the receiver.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2094
     this method should NOT be redefined in subclasses."
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2095
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2096
    Inspector isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2097
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2098
	 for systems without GUI
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2099
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2100
	Transcript showCr:'no Inspector'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2101
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2102
	Inspector openOn:self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2103
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2104
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2105
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2106
inspect
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2107
    "launch an inspector on the receiver.
282
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2108
     this method (or better: inspectorClass) can be redefined in subclasses 
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2109
     to start special inspectors."
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2110
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2111
    |cls|
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2112
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2113
    cls := self inspectorClass.
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2114
    cls isNil ifTrue:[
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2115
	^ self basicInspect
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2116
    ].
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2117
    cls openOn:self
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2118
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2119
    "
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2120
     Object new inspect
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2121
     (1 @ 2) inspect
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2122
     Smalltalk inspect
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2123
     #(1 2 3) asOrderedCollection inspect
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2124
     (Color red) inspect
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2125
     (Image fromFile:'bitmaps/garfield.gif') inspect
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2126
    "
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2127
!
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2128
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2129
inspectorClass
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2130
    "return the class to use for inspect. 
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2131
     Can (should) be redefined in classes for which a better inspector is available"
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2132
94f5c3a6230d *** empty log message ***
claus
parents: 272
diff changeset
  2133
    ^ Inspector
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2134
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2135
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2136
!Object methodsFor:'converting'!
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2137
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2138
asValue
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2139
    "return a valueHolder for for the receiver"
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2140
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2141
    ^ ValueHolder with:self
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2142
! !
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2143
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2144
!Object methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2145
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2146
at:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2147
    "return the indexed instance variable with index, anInteger;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2148
     this method can be redefined in subclasses."
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2149
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2150
    ^ self basicAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2151
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2152
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2153
basicAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2154
    "return the indexed instance variable with index, anInteger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2155
     Trigger an error if the receiver has no indexed instance variables.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2156
     This method should NOT be redefined in any subclass"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2157
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2158
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2159
329
claus
parents: 325
diff changeset
  2160
    REGISTER int nbytes, indx;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2161
    OBJ myClass;
329
claus
parents: 325
diff changeset
  2162
    REGISTER char *pFirst;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2163
    unsigned char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2164
    unsigned short *sp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2165
    long *lp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2166
    OBJ *op;
329
claus
parents: 325
diff changeset
  2167
/*    int nInstBytes, nInstVars, flags; */
claus
parents: 325
diff changeset
  2168
    REGISTER int n;
228
22bcd39b30bb makeLarge rename
claus
parents: 216
diff changeset
  2169
    extern OBJ _MKLARGEINT();
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2170
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2171
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2172
    /*
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  2173
     * notice the missing test for self being a nonNilObject -
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2174
     * this can be done since basicAt: is defined both in UndefinedObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2175
     * and SmallInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2176
     */
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  2177
    if (__isSmallInteger(index)) {
329
claus
parents: 325
diff changeset
  2178
	myClass = __qClass(self);
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2179
	indx = _intVal(index) - 1;
329
claus
parents: 325
diff changeset
  2180
	n /* nInstVars */ = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
claus
parents: 325
diff changeset
  2181
	n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);
claus
parents: 325
diff changeset
  2182
	nbytes = __qSize(self) - n /* nInstBytes */;
claus
parents: 325
diff changeset
  2183
	pFirst = (char *)(_InstPtr(self)) + n /* nInstBytes */;
claus
parents: 325
diff changeset
  2184
claus
parents: 325
diff changeset
  2185
	/* 
claus
parents: 325
diff changeset
  2186
	 * replaced switch by open-coded if; this is slightly faster 
claus
parents: 325
diff changeset
  2187
	 * since it avoids the range check and also handles the most common case first
claus
parents: 325
diff changeset
  2188
	 */
claus
parents: 325
diff changeset
  2189
	n = _intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK;
claus
parents: 325
diff changeset
  2190
	if ((n == POINTERARRAY) || (n == WKPOINTERARRAY)) {
claus
parents: 325
diff changeset
  2191
	    if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {
claus
parents: 325
diff changeset
  2192
		op = (OBJ *)pFirst + indx;
claus
parents: 325
diff changeset
  2193
		RETURN ( *op );
claus
parents: 325
diff changeset
  2194
	    }
claus
parents: 325
diff changeset
  2195
	} else if (n == BYTEARRAY) {
claus
parents: 325
diff changeset
  2196
	    if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {
claus
parents: 325
diff changeset
  2197
		cp = (unsigned char *)pFirst + indx;
claus
parents: 325
diff changeset
  2198
		RETURN ( _MKSMALLINT(*cp & 0xFF) );
claus
parents: 325
diff changeset
  2199
	    }
claus
parents: 325
diff changeset
  2200
	} else if (n == FLOATARRAY) {
claus
parents: 325
diff changeset
  2201
	    if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
claus
parents: 325
diff changeset
  2202
		float *fp;
claus
parents: 325
diff changeset
  2203
claus
parents: 325
diff changeset
  2204
		fp = (float *)pFirst + indx;
claus
parents: 325
diff changeset
  2205
		RETURN ( _MKFLOAT((double)(*fp)) COMMA_CON );
claus
parents: 325
diff changeset
  2206
	    }
claus
parents: 325
diff changeset
  2207
	} else if (n == DOUBLEARRAY) {
claus
parents: 325
diff changeset
  2208
	    if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
claus
parents: 325
diff changeset
  2209
		double *dp;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2210
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  2211
#ifdef NEED_DOUBLE_ALIGN
329
claus
parents: 325
diff changeset
  2212
		/*
claus
parents: 325
diff changeset
  2213
		 * care for filler
claus
parents: 325
diff changeset
  2214
		 */
claus
parents: 325
diff changeset
  2215
		pFirst += sizeof(FILLTYPE);
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  2216
#endif
329
claus
parents: 325
diff changeset
  2217
		dp = (double *)pFirst + indx;
claus
parents: 325
diff changeset
  2218
		RETURN ( _MKFLOAT(*dp) COMMA_CON );
claus
parents: 325
diff changeset
  2219
	    }
claus
parents: 325
diff changeset
  2220
	} else if (n == LONGARRAY) {
claus
parents: 325
diff changeset
  2221
	    if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {
claus
parents: 325
diff changeset
  2222
		lp = (long *)pFirst + indx;
claus
parents: 325
diff changeset
  2223
		if ((*lp >= _MIN_INT) && (*lp <= _MAX_INT))
claus
parents: 325
diff changeset
  2224
		    RETURN ( _MKSMALLINT(*lp) );
claus
parents: 325
diff changeset
  2225
		RETURN ( _MKLARGEINT(*lp) );
claus
parents: 325
diff changeset
  2226
	    }
claus
parents: 325
diff changeset
  2227
	} else if (n == WORDARRAY) {
claus
parents: 325
diff changeset
  2228
	    if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {
claus
parents: 325
diff changeset
  2229
		sp = (unsigned short *)pFirst + indx;
claus
parents: 325
diff changeset
  2230
		RETURN ( _MKSMALLINT(*sp & 0xFFFF) );
claus
parents: 325
diff changeset
  2231
	    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2232
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2233
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2234
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2235
.
10
claus
parents: 5
diff changeset
  2236
    index isInteger ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2237
	^ self indexNotInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2238
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2239
    ^ self subscriptBoundsError:index
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2240
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2241
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2242
at:index put:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2243
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2244
     this method can be redefined in subclasses."
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2245
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2246
    ^ self basicAt:index put:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2247
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2248
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2249
basicAt:index put:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2250
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2251
     Trigger an error if the receiver has no indexed instance variables.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2252
     This method should NOT be redefined in any subclass"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2253
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2254
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2255
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2256
    register int nbytes, indx;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2257
    OBJ myClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2258
    register char *pFirst;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2259
    char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2260
    short *sp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2261
    long *lp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2262
    OBJ *op;
329
claus
parents: 325
diff changeset
  2263
/*    int nInstBytes, ninstvars, flags; */
claus
parents: 325
diff changeset
  2264
    REGISTER int n;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2265
    int val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2266
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  2267
    /* notice the missing test for self being a nonNilObject -
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  2268
       this can be done since basicAt: is defined both in UndefinedObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2269
       and SmallInteger */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2270
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  2271
    if (__isSmallInteger(index)) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2272
	indx = _intVal(index) - 1;
329
claus
parents: 325
diff changeset
  2273
	myClass = __qClass(self);
claus
parents: 325
diff changeset
  2274
	n /* ninstvars */ = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
claus
parents: 325
diff changeset
  2275
	n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);
claus
parents: 325
diff changeset
  2276
	nbytes = __qSize(self) - n /* nInstBytes */;
claus
parents: 325
diff changeset
  2277
	pFirst = (char *)(_InstPtr(self)) + n /* nInstBytes */;
claus
parents: 325
diff changeset
  2278
claus
parents: 325
diff changeset
  2279
	n = _intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK;
claus
parents: 325
diff changeset
  2280
	if ((n == POINTERARRAY) || (n == WKPOINTERARRAY)) {
claus
parents: 325
diff changeset
  2281
	    if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {
claus
parents: 325
diff changeset
  2282
		op = (OBJ *)pFirst + indx;
claus
parents: 325
diff changeset
  2283
		*op = anObject;
claus
parents: 325
diff changeset
  2284
		__STORE(self, anObject);
claus
parents: 325
diff changeset
  2285
		RETURN ( anObject );
claus
parents: 325
diff changeset
  2286
	    }
claus
parents: 325
diff changeset
  2287
	} else if (n == BYTEARRAY) {
claus
parents: 325
diff changeset
  2288
	    if (__isSmallInteger(anObject)) {
claus
parents: 325
diff changeset
  2289
		val = _intVal(anObject);
claus
parents: 325
diff changeset
  2290
		if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
claus
parents: 325
diff changeset
  2291
		    if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {
claus
parents: 325
diff changeset
  2292
			cp = pFirst + indx;
claus
parents: 325
diff changeset
  2293
			*cp = val;
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2294
			RETURN ( anObject );
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2295
		    }
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2296
		}
329
claus
parents: 325
diff changeset
  2297
	    }
claus
parents: 325
diff changeset
  2298
	} else if (n == FLOATARRAY) {
claus
parents: 325
diff changeset
  2299
	    if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
claus
parents: 325
diff changeset
  2300
		float *fp;
claus
parents: 325
diff changeset
  2301
claus
parents: 325
diff changeset
  2302
		fp = (float *)pFirst + indx;
claus
parents: 325
diff changeset
  2303
		if (__isFloatLike(anObject)) {
claus
parents: 325
diff changeset
  2304
		    *fp = _floatVal(anObject);
claus
parents: 325
diff changeset
  2305
		    RETURN ( anObject );
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2306
		}
329
claus
parents: 325
diff changeset
  2307
		if (__isSmallInteger(anObject)) {
claus
parents: 325
diff changeset
  2308
		    *fp = (float) _intVal(anObject);
claus
parents: 325
diff changeset
  2309
		    RETURN ( anObject );
claus
parents: 325
diff changeset
  2310
		}
claus
parents: 325
diff changeset
  2311
	    }
claus
parents: 325
diff changeset
  2312
	} else if (n == DOUBLEARRAY) {
claus
parents: 325
diff changeset
  2313
	    if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
claus
parents: 325
diff changeset
  2314
		double *dp;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2315
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  2316
#ifdef NEED_DOUBLE_ALIGN
329
claus
parents: 325
diff changeset
  2317
		/*
claus
parents: 325
diff changeset
  2318
		 * care for filler
claus
parents: 325
diff changeset
  2319
		 */
claus
parents: 325
diff changeset
  2320
		pFirst += sizeof(FILLTYPE);
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  2321
#endif
329
claus
parents: 325
diff changeset
  2322
		dp = (double *)pFirst + indx;
claus
parents: 325
diff changeset
  2323
		if (__isFloatLike(anObject)) {
claus
parents: 325
diff changeset
  2324
		    *dp = _floatVal(anObject);
claus
parents: 325
diff changeset
  2325
		    RETURN ( anObject );
claus
parents: 325
diff changeset
  2326
		}
claus
parents: 325
diff changeset
  2327
		if (__isSmallInteger(anObject)) {
claus
parents: 325
diff changeset
  2328
		    *dp = (double) _intVal(anObject);
claus
parents: 325
diff changeset
  2329
		    RETURN ( anObject );
claus
parents: 325
diff changeset
  2330
		}
claus
parents: 325
diff changeset
  2331
	    }
claus
parents: 325
diff changeset
  2332
	} else if (n == LONGARRAY) {
claus
parents: 325
diff changeset
  2333
	    if (__isSmallInteger(anObject)) {
claus
parents: 325
diff changeset
  2334
		if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {
claus
parents: 325
diff changeset
  2335
		    lp = (long *)pFirst + indx;
claus
parents: 325
diff changeset
  2336
		    *lp = _intVal(anObject);
claus
parents: 325
diff changeset
  2337
		    RETURN ( anObject );
claus
parents: 325
diff changeset
  2338
		}
claus
parents: 325
diff changeset
  2339
	    }
claus
parents: 325
diff changeset
  2340
	    /* XXX
claus
parents: 325
diff changeset
  2341
	     * XXX must add possibility to put in a large number here
claus
parents: 325
diff changeset
  2342
	     * XXX
claus
parents: 325
diff changeset
  2343
	     */
claus
parents: 325
diff changeset
  2344
	} else if (n == WORDARRAY) {
claus
parents: 325
diff changeset
  2345
	    if (__isSmallInteger(anObject)) {
claus
parents: 325
diff changeset
  2346
		val = _intVal(anObject);
claus
parents: 325
diff changeset
  2347
		if ((val >= 0) && (val <= 0xFFFF)) {
claus
parents: 325
diff changeset
  2348
		    if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {
339
claus
parents: 332
diff changeset
  2349
			sp = (short *)pFirst + indx;
claus
parents: 332
diff changeset
  2350
			*sp = val;
claus
parents: 332
diff changeset
  2351
			RETURN ( anObject );
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2352
		    }
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2353
		}
329
claus
parents: 325
diff changeset
  2354
	    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2355
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2356
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2357
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2358
.
10
claus
parents: 5
diff changeset
  2359
    index isInteger ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2360
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2361
	 the index should be an integer number
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2362
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2363
	^ self indexNotInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2364
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2365
    (index between:1 and:self size) ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2366
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2367
	 the index is less than 1 or greater than the size of the
213
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  2368
	 receiver collection
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2369
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2370
	^ self subscriptBoundsError:index
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2371
    ].
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2372
    (self class isFloats) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2373
	anObject isNumber ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2374
	    ^ self basicAt:index put:(anObject asFloat)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2375
	]
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2376
    ].
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2377
    (self class isDoubles) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2378
	anObject isNumber ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2379
	    ^ self basicAt:index put:(anObject asFloat)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2380
	]
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2381
    ].
10
claus
parents: 5
diff changeset
  2382
    anObject isInteger ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2383
	"
213
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  2384
	 the object to put into the receiver collection
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2385
	 should be an integer number
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2386
	"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2387
	^ self elementNotInteger
2
claus
parents: 1
diff changeset
  2388
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2389
    "
213
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  2390
     the object to put into the receiver collection
362
claus
parents: 359
diff changeset
  2391
     is not an instance of the expected element class,
claus
parents: 359
diff changeset
  2392
     or the value is  not within the elements valid range.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2393
    "
2
claus
parents: 1
diff changeset
  2394
    ^ self elementBoundsError
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2395
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2396
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2397
instVarAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2398
    "return a non-indexed instance variable;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2399
     peeking into an object this way is not very object oriented 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2400
     - use with care (needed for copy, inspector etc.)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2401
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2402
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2403
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2404
    OBJ myClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2405
    int idx, ninstvars;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2406
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  2407
    if (__isSmallInteger(index)) {
329
claus
parents: 325
diff changeset
  2408
	myClass = __Class(self);
357
claus
parents: 356
diff changeset
  2409
	idx = _intVal(index) - 1;
claus
parents: 356
diff changeset
  2410
	/*
claus
parents: 356
diff changeset
  2411
	 * do not allow return of non-object fields.
claus
parents: 356
diff changeset
  2412
	 * if subclass did not make privisions for that,
claus
parents: 356
diff changeset
  2413
	 * we wont do so here ...
claus
parents: 356
diff changeset
  2414
	 */
claus
parents: 356
diff changeset
  2415
	if (((INT)(_ClassInstPtr(myClass)->c_flags) & _MASKSMALLINT(NONOBJECT_INSTS))) {
claus
parents: 356
diff changeset
  2416
	    if (idx == 0) {
claus
parents: 356
diff changeset
  2417
		RETURN ( nil )
claus
parents: 356
diff changeset
  2418
	    }
claus
parents: 356
diff changeset
  2419
	}
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2420
	ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2421
	if ((idx >= 0) && (idx < ninstvars)) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2422
	    RETURN ( _InstPtr(self)->i_instvars[idx] );
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2423
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2424
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2425
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2426
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2427
    index isInteger ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2428
	^ self indexNotInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2429
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2430
    ^ self subscriptBoundsError:index
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2431
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2432
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2433
instVarAt:index put:value
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2434
    "change a non-indexed instance variable;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2435
     peeking into an object this way is not very object oriented 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2436
     - use with care (needed for copy, inspector etc.)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2437
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2438
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2439
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2440
    OBJ myClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2441
    int idx, ninstvars;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2442
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  2443
    if (__isSmallInteger(index)) {
329
claus
parents: 325
diff changeset
  2444
	myClass = __Class(self);
357
claus
parents: 356
diff changeset
  2445
	idx = _intVal(index) - 1;
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2446
	ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
357
claus
parents: 356
diff changeset
  2447
	/*
claus
parents: 356
diff changeset
  2448
	 * do not allow setting of non-object fields.
claus
parents: 356
diff changeset
  2449
	 * if subclass did not make privisions for that,
claus
parents: 356
diff changeset
  2450
	 * we wont do so here ...
claus
parents: 356
diff changeset
  2451
	 */
claus
parents: 356
diff changeset
  2452
	if (((INT)(_ClassInstPtr(myClass)->c_flags) & _MASKSMALLINT(NONOBJECT_INSTS))) {
claus
parents: 356
diff changeset
  2453
	    if (idx == 0) {
claus
parents: 356
diff changeset
  2454
		RETURN ( nil )
claus
parents: 356
diff changeset
  2455
	    }
claus
parents: 356
diff changeset
  2456
	}
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2457
	if ((idx >= 0) && (idx < ninstvars)) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2458
	    _InstPtr(self)->i_instvars[idx] = value;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2459
	    __STORE(self, value);
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2460
	    RETURN ( value );
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2461
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2462
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2463
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2464
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2465
    index isInteger ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2466
	^ self indexNotInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2467
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2468
    ^ self subscriptBoundsError:index
359
claus
parents: 357
diff changeset
  2469
!
claus
parents: 357
diff changeset
  2470
claus
parents: 357
diff changeset
  2471
instVarNamed:name 
claus
parents: 357
diff changeset
  2472
    "return a non-indexed instance variables value by name;
claus
parents: 357
diff changeset
  2473
     peeking into an object this way is not very object oriented 
claus
parents: 357
diff changeset
  2474
     - use with care (provided for inspectors)"
claus
parents: 357
diff changeset
  2475
claus
parents: 357
diff changeset
  2476
    ^ self instVarAt:(self class instVarOffsetOf:name)
claus
parents: 357
diff changeset
  2477
!
claus
parents: 357
diff changeset
  2478
claus
parents: 357
diff changeset
  2479
instVarNamed:name put:value
claus
parents: 357
diff changeset
  2480
    "set a non-indexed instance variable by name;
claus
parents: 357
diff changeset
  2481
     peeking into an object this way is not very object oriented 
claus
parents: 357
diff changeset
  2482
     - use with care (provided for inspectors)"
claus
parents: 357
diff changeset
  2483
claus
parents: 357
diff changeset
  2484
    ^ self instVarAt:(self class instVarOffsetOf:name) put:value
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2485
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2486
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2487
!Object methodsFor:'dependents access'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2488
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2489
dependents
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2490
    "return a Collection of dependents - nil if there is none.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2491
     The default implementation here uses a global Dictionary to store
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2492
     dependents which may be too slow for high frequency change&update.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2493
     Therefore, some classes (Model) redefine this for better performance."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2494
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2495
    ^ Dependencies at:self ifAbsent:[nil]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2496
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2497
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2498
dependents:aCollection
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2499
    "set the collection of dependents.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2500
     The default implementation here uses a global Dictionary to store
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2501
     dependents which may be too slow for high frequency change&update.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2502
     Therefore, some classes (Model) redefine this for better performance."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2503
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2504
    (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2505
	Dependencies removeKey:self ifAbsent:[]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2506
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2507
	Dependencies at:self put:aCollection
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2508
    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2509
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2510
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2511
dependentsDo:aBlock
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2512
    "evaluate aBlock for all of my dependents"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2513
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2514
    |deps|
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2515
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2516
    deps := self dependents.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2517
    deps notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2518
	deps do:aBlock 
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2519
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2520
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2521
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2522
addDependent:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2523
    "make the argument, anObject be a dependent of the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2524
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2525
    |deps|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2526
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2527
    deps := self dependents.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2528
    deps isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2529
	self dependents:(WeakIdentitySet with:anObject)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2530
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2531
	deps add:anObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2532
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2533
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2534
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2535
removeDependent:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2536
    "make the argument, anObject be independent of the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2537
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2538
    |deps|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2539
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2540
    deps := self dependents.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2541
    deps notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2542
	deps remove:anObject ifAbsent:[].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2543
	deps isEmpty ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2544
	    self dependents:nil
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2545
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2546
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2547
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2548
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2549
release
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2550
    "remove all dependencies from the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2551
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2552
    self dependents:nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2553
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2554
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2555
!Object methodsFor:'change and update'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2556
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2557
changeRequest
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2558
    "the receiver wants to change - check if all dependents
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2559
     grant the request, and return true if so"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2560
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2561
    self dependentsDo:[:dependent | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2562
	dependent updateRequest ifFalse:[^ false].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2563
    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2564
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2565
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2566
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2567
changeRequest:aParameter
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2568
    "the receiver wants to change - check if all dependents
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2569
     grant the request, and return true if so"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2570
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2571
    self dependentsDo:[:dependent | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2572
	(dependent updateRequest:aParameter) ifFalse:[^ false].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2573
    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2574
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2575
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2576
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2577
changeRequestFrom:anObject
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2578
    "the receiver wants to change - check if all dependents
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2579
     except anObject grant the request, and return true if so.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2580
     The argument anObject is typically going to be the one who is
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2581
     about to send the change request."
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2582
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2583
    self dependentsDo:[:dependent | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2584
	dependent == anObject ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2585
	    (dependent updateRequest) ifFalse:[^ false].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2586
	]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2587
    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2588
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2589
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2590
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2591
changeRequest:aParameter from:anObject
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2592
    "the receiver wants to change - check if all dependents
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2593
     except anObject grant the request, and return true if so.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2594
     The argument anObject is typically going to be the one who is
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2595
     about to send the change request."
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2596
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2597
    self dependentsDo:[:dependent | 
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2598
	dependent == anObject ifFalse:[
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2599
	    (dependent updateRequest:aParameter) ifFalse:[^ false].
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2600
	]
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2601
    ].
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2602
    ^ true
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2603
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2604
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2605
changed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2606
    "notify all dependents that the receiver has changed.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2607
     Each dependent gets a '#update:'-message with the original
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2608
     receiver as argument."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2609
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2610
    self changed:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2611
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2612
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2613
changed:aParameter
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2614
    "notify all dependents that the receiver has changed somehow.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2615
     Each dependent gets a '#update:'-message with aParameter
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2616
     as argument."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2617
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2618
    self changed:aParameter with:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2619
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2620
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2621
changed:aParameter with:anArgument
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2622
    "notify all dependents that the receiver has changed somehow.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2623
     Each dependent gets a  '#update:with:from:'-message, with aParameter
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2624
     and anArgument as arguments."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2625
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2626
    self dependentsDo:[:dependent | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2627
	dependent update:aParameter with:anArgument from:self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2628
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2629
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2630
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2631
broadcast:aSelectorSymbol
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2632
    "send a message with selector aSelectorSymbol to all my dependents"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2633
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2634
    self dependentsDo:[:dependent | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2635
	dependent perform:aSelectorSymbol
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2636
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2637
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2638
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2639
broadcast:aSelectorSymbol with:anArgument
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2640
    "send a message with selector aSelectorSymbol with an additional
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2641
     argument anArgument to all my dependents."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2642
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2643
    self dependentsDo:[:dependent | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2644
	dependent perform:aSelectorSymbol with:anArgument
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2645
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2646
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2647
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2648
update:aParameter
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2649
    "the message is sent to a dependent, when one of the objects
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2650
     on whom the receiver depends, has changed. The argument aParameter
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2651
     is either the changed object or the argument to the #changed: message.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2652
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2653
     Default behavior here is to do nothing"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2654
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2655
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2656
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2657
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2658
update:aParameter with:anArgument
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2659
    "dependent is notified of some change -
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2660
     Default is to try update:"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2661
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2662
    ^ self update:aParameter
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2663
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2664
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2665
update:aParameter with:anArgument from:sender
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2666
    "dependent is notified of some change -
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2667
     Default is to try update:with:"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2668
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2669
    ^ self update:aParameter with:anArgument
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2670
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2671
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2672
updateRequest
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2673
    "return true, if an update request is granted.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2674
     Default here is to grant updates - may be used
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2675
     to lock updates if someone is making other changes
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2676
     from within an update. Or if someone has locked its
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2677
     state and does not want others to change things.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2678
     However, these dependents must all honor the
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2679
     changeRequest - ifTrue - change protocol. I.e. they
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2680
     must first ask all others via changeRequest, and only do the change
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2681
     it returns true. The others must decide in updateRequest and
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  2682
     return true if they think a change is ok."
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2683
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2684
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2685
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2686
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2687
updateRequest:aSymbol
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2688
    "return true, if an update request is granted.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2689
     Default here a simple updateRequest"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2690
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2691
    ^ self updateRequest
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2692
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2693
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2694
!Object methodsFor:'secure message sending'!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2695
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2696
askFor:aSelector
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2697
    "try to send the receiver the message, aSelector.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2698
     If it does not understand it, return false. Otherwise
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2699
     the real value returned.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2700
     Useful to send messages such as: 'isColor' to unknown
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2701
     receivers."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2702
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2703
    ^ self perform:aSelector ifNotUnderstood:[false]
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2704
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2705
    "
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2706
     1 askFor:#isColor
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2707
    "
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2708
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2709
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2710
perform:aSelector ifNotUnderstood:exceptionBlock
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2711
    "try to send message aSelector to the receiver.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2712
     If its understood, return the methods returned value,
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2713
     otherwise return the value of the exceptionBlock"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2714
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2715
    |val|
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2716
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2717
    MessageNotUnderstoodSignal handle:[:ex |
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2718
	^ exceptionBlock value
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2719
    ] do:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2720
	val := self perform:aSelector
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2721
    ].
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2722
    ^ val
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2723
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2724
    "
325
claus
parents: 324
diff changeset
  2725
     1.2345 perform:#foo ifNotUnderstood:['sorry'] 
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2726
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2727
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2728
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2729
perform:aSelector with:argument ifNotUnderstood:exceptionBlock
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2730
    "try to send message aSelector to the receiver.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2731
     If its understood, return the methods returned value,
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2732
     otherwise return the value of the exceptionBlock"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2733
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2734
    |val|
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2735
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2736
    MessageNotUnderstoodSignal handle:[:ex |
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2737
	^ exceptionBlock value
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2738
    ] do:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2739
	val := self perform:aSelector with:argument
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2740
    ].
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2741
    ^ val
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2742
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2743
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2744
     |unknown|
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2745
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2746
     unknown := 1.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2747
     (unknown perform:#+ with:2 ifNotUnderstood:['sorry']) printNewline.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2748
     unknown := 'high there'.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2749
     (unknown perform:#+ with:2 ifNotUnderstood:['sorry']) printNewline.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2750
    "
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2751
! !
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2752
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2753
!Object methodsFor:'message sending'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2754
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2755
perform:aSelector
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2756
    "send the message aSelector to the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2757
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2758
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2759
213
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  2760
#if !defined(hppa) && !defined(mips)
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2761
#define PRE_2_11
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  2762
#endif
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  2763
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2764
#ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2765
    static struct inlineCache ilc = _ILC0;
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2766
    struct inlineCache lilc = _DUMMYILC0;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2767
#else
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2768
    static struct inlineCache ilc = _DUMMYILC0;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2769
    struct inlineCache lilc;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2770
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2771
    static OBJ lastSelector = nil;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2772
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2773
#if defined(THIS_CONTEXT)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2774
    /*
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2775
     * must set lineno in sender by hand here ... (because of NOCONTEXT)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2776
     */
329
claus
parents: 325
diff changeset
  2777
    _ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2778
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2779
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2780
#ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2781
    if (aSelector != lastSelector) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2782
	ilc.ilc_func = _SEND0;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2783
	lastSelector = aSelector;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2784
    }
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2785
#else
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2786
    lilc = ilc;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2787
#endif
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2788
329
claus
parents: 325
diff changeset
  2789
#if !defined(TRADITIONAL_STACK_FRAME)
claus
parents: 325
diff changeset
  2790
    lilc.ilc_lineNo = __pilc->ilc_lineNo;
claus
parents: 325
diff changeset
  2791
#endif
claus
parents: 325
diff changeset
  2792
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2793
#if defined(xxTHIS_CONTEXT)
85
claus
parents: 77
diff changeset
  2794
# ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2795
    ilc.ilc_lineNo = __pilc->ilc_lineNo;
85
claus
parents: 77
diff changeset
  2796
# else
claus
parents: 77
diff changeset
  2797
    lilc.ilc_lineNo = __pilc->ilc_lineNo;
claus
parents: 77
diff changeset
  2798
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2799
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2800
85
claus
parents: 77
diff changeset
  2801
#ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2802
    RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc) );
85
claus
parents: 77
diff changeset
  2803
#else
claus
parents: 77
diff changeset
  2804
    RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc) );
claus
parents: 77
diff changeset
  2805
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2806
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2807
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2808
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2809
perform:aSelector with:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2810
    "send the one-arg-message aSelector to the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2811
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2812
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2813
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2814
#ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2815
    static struct inlineCache ilc = _ILC1;
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2816
    struct inlineCache lilc = _DUMMYILC1;
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2817
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2818
    static OBJ lastSelector = nil;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2819
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2820
# if defined(THIS_CONTEXT)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2821
    /*
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2822
     * must set lineno in sender by hand here ... (because of NOCONTEXT)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2823
     */
329
claus
parents: 325
diff changeset
  2824
    _ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2825
# endif
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2826
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2827
    if (aSelector != lastSelector) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2828
	ilc.ilc_func = _SEND1;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2829
	lastSelector = aSelector;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2830
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2831
    ilc.ilc_lineNo = __pilc->ilc_lineNo;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2832
    RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, anObject) );
85
claus
parents: 77
diff changeset
  2833
#else
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2834
    static struct inlineCache ilc = _DUMMYILC1;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2835
    struct inlineCache lilc;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2836
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2837
# if defined(THIS_CONTEXT)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2838
    /*
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2839
     * must set lineno in sender by hand here ... (because of NOCONTEXT)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2840
     */
329
claus
parents: 325
diff changeset
  2841
    _ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2842
# endif
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2843
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2844
    lilc = ilc;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2845
    lilc.ilc_lineNo = __pilc->ilc_lineNo;
85
claus
parents: 77
diff changeset
  2846
    RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, anObject) );
claus
parents: 77
diff changeset
  2847
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2848
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2849
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2850
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2851
perform:aSelector with:firstObject with:secondObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2852
    "send the two-arg-message aSelector to the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2853
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2854
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2855
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2856
#ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2857
    static struct inlineCache ilc = _ILC2;
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2858
    struct inlineCache lilc = _DUMMYILC2;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2859
#else
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2860
    static struct inlineCache ilc = _DUMMYILC2;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2861
    struct inlineCache lilc;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2862
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2863
    static OBJ lastSelector = nil;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2864
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2865
#if defined(THIS_CONTEXT)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2866
    /*
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2867
     * must set lineno in sender by hand here ... (because of NOCONTEXT)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2868
     */
329
claus
parents: 325
diff changeset
  2869
   _ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2870
#endif
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2871
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2872
#ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2873
    if (aSelector != lastSelector) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2874
	ilc.ilc_func = _SEND2;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2875
	lastSelector = aSelector;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2876
    }
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2877
#else
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2878
    lilc = ilc;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2879
#endif
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2880
329
claus
parents: 325
diff changeset
  2881
#if !defined(TRADITIONAL_STACK_FRAME)
claus
parents: 325
diff changeset
  2882
    lilc.ilc_lineNo = __pilc->ilc_lineNo;
claus
parents: 325
diff changeset
  2883
#endif
claus
parents: 325
diff changeset
  2884
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2885
#if defined(xxTHIS_CONTEXT)
85
claus
parents: 77
diff changeset
  2886
# ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2887
    ilc.ilc_lineNo = __pilc->ilc_lineNo;
85
claus
parents: 77
diff changeset
  2888
# else
claus
parents: 77
diff changeset
  2889
    lilc.ilc_lineNo = __pilc->ilc_lineNo;
claus
parents: 77
diff changeset
  2890
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2891
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2892
85
claus
parents: 77
diff changeset
  2893
# ifdef PRE_2_11
claus
parents: 77
diff changeset
  2894
    RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, firstObject, secondObject));
claus
parents: 77
diff changeset
  2895
# else
claus
parents: 77
diff changeset
  2896
    RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, firstObject, secondObject));
claus
parents: 77
diff changeset
  2897
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2898
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2899
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2900
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2901
perform:aSelector with:firstObject with:secondObject with:thirdObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2902
    "send the three-arg-message aSelector to the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2903
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2904
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2905
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2906
#ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2907
    static struct inlineCache ilc = _ILC3;
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2908
    struct inlineCache lilc = _DUMMYILC3;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2909
#else
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2910
    static struct inlineCache ilc = _DUMMYILC3;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2911
    struct inlineCache lilc;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2912
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2913
    static OBJ lastSelector = nil;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2914
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2915
#if defined(THIS_CONTEXT)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2916
    /*
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2917
     * must set lineno in sender by hand here ... (because of NOCONTEXT)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2918
     */
329
claus
parents: 325
diff changeset
  2919
    _ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2920
#endif
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2921
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2922
#ifdef PRE_2_11
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2923
    if (aSelector != lastSelector) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2924
	ilc.ilc_func = _SEND3;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2925
	lastSelector = aSelector;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2926
    }
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2927
#else
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2928
    lilc = ilc;
329
claus
parents: 325
diff changeset
  2929
# if !defined(TRADITIONAL_STACK_FRAME)
claus
parents: 325
diff changeset
  2930
    lilc.ilc_lineNo = __pilc->ilc_lineNo;
claus
parents: 325
diff changeset
  2931
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2932
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2933
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2934
#if defined(xxTHIS_CONTEXT)
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2935
# ifdef PRE_2_11
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2936
    ilc.ilc_lineNo = __pilc->ilc_lineNo;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2937
# else
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2938
    lilc.ilc_lineNo = __pilc->ilc_lineNo;
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2939
# endif
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2940
#endif
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2941
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2942
# ifdef PRE_2_11
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2943
    RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, firstObject, secondObject, thirdObject));
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2944
# else
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2945
    RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, firstObject, secondObject, thirdObject));
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2946
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2947
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2948
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2949
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2950
perform:aSelector withArguments:argArray
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2951
    "send the message aSelector with all args taken from argArray 
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  2952
     to the receiver."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2953
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  2954
    |numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2955
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2956
    numberOfArgs := argArray size.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2957
%{
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  2958
    extern OBJ Array, __AT_();
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2959
    REGISTER OBJ *argP;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2960
    int nargs, i;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2961
    static OBJ last0 = nil; static struct inlineCache ilc0 = _ILC0;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2962
    static OBJ last1 = nil; static struct inlineCache ilc1 = _ILC1;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2963
    static OBJ last2 = nil; static struct inlineCache ilc2 = _ILC2;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2964
    static OBJ last3 = nil; static struct inlineCache ilc3 = _ILC3;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2965
    static OBJ last4 = nil; static struct inlineCache ilc4 = _ILC4;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2966
    static OBJ last5 = nil; static struct inlineCache ilc5 = _ILC5;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2967
    static OBJ last6 = nil; static struct inlineCache ilc6 = _ILC6;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2968
    static OBJ last7 = nil; static struct inlineCache ilc7 = _ILC7;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2969
    static OBJ last8 = nil; static struct inlineCache ilc8 = _ILC8;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2970
    static OBJ last9 = nil; static struct inlineCache ilc9 = _ILC9;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2971
    static OBJ last10 = nil; static struct inlineCache ilc10 = _ILC10;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2972
    static OBJ last11 = nil; static struct inlineCache ilc11 = _ILC11;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2973
    static OBJ last12 = nil; static struct inlineCache ilc12 = _ILC12;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2974
    static OBJ last13 = nil; static struct inlineCache ilc13 = _ILC13;
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2975
    static OBJ last14 = nil; static struct inlineCache ilc14 = _ILC14;
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2976
    static OBJ last15 = nil; static struct inlineCache ilc15 = _ILC15;
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2977
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2978
#if defined(xxxTHIS_CONTEXT)
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2979
    /*
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2980
     * must set lineno in sender by hand here ... (because of NOCONTEXT)
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2981
     */
329
claus
parents: 325
diff changeset
  2982
    _ContextInstPtr(__sender)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2983
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2984
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  2985
    if (__isSmallInteger(numberOfArgs)) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2986
	nargs = _intVal(numberOfArgs);
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2987
	if (nargs == 0) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2988
	    if (aSelector != last0) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2989
		ilc0.ilc_func = _SEND0;
332
claus
parents: 329
diff changeset
  2990
		if (ilc0.ilc_poly) {
339
claus
parents: 332
diff changeset
  2991
		    __flushPolyCache(ilc0.ilc_poly);
claus
parents: 332
diff changeset
  2992
		    ilc0.ilc_poly = 0;
claus
parents: 332
diff changeset
  2993
		}
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2994
		last0 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2995
	    }
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2996
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2997
	    ilc0.ilc_lineNo = __pilc->ilc_lineNo;
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  2998
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  2999
	    RETURN ((*ilc0.ilc_func)(self, aSelector, CON_COMMA nil, &ilc0));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3000
	}
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3001
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3002
	if (__isArray(argArray)) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3003
	    argP = _ArrayInstPtr(argArray)->a_element;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3004
	} else {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3005
	    argP = (OBJ *)(&a1);
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3006
	    for (i=1; i <= nargs; i++) {
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  3007
		*argP++ = __AT_(argArray, CON_COMMA _MKSMALLINT(i));
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3008
	    }
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3009
	}
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3010
	switch (nargs) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3011
	    case 1: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3012
		if (aSelector != last1) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3013
		    ilc1.ilc_func = _SEND1;
332
claus
parents: 329
diff changeset
  3014
		    if (ilc1.ilc_poly) {
339
claus
parents: 332
diff changeset
  3015
			__flushPolyCache(ilc1.ilc_poly);
claus
parents: 332
diff changeset
  3016
			ilc1.ilc_poly = 0;
claus
parents: 332
diff changeset
  3017
		    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3018
		    last1 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3019
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3020
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3021
		ilc1.ilc_lineNo = __pilc->ilc_lineNo;
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3022
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3023
		RETURN ( (*ilc1.ilc_func)(self, aSelector, CON_COMMA nil, &ilc1, argP[0]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3024
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3025
	    case 2: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3026
		if (aSelector != last2) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3027
		    ilc2.ilc_func = _SEND2;
332
claus
parents: 329
diff changeset
  3028
		    if (ilc2.ilc_poly) {
339
claus
parents: 332
diff changeset
  3029
			__flushPolyCache(ilc2.ilc_poly);
claus
parents: 332
diff changeset
  3030
			ilc2.ilc_poly = 0;
claus
parents: 332
diff changeset
  3031
		    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3032
		    last2 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3033
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3034
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3035
		ilc2.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3036
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3037
		RETURN ( (*ilc2.ilc_func)(self, aSelector, CON_COMMA nil, &ilc2, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3038
						argP[0], argP[1]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3039
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3040
	    case 3: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3041
		if (aSelector != last3) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3042
		    ilc3.ilc_func = _SEND3;
332
claus
parents: 329
diff changeset
  3043
		    if (ilc3.ilc_poly) {
339
claus
parents: 332
diff changeset
  3044
			__flushPolyCache(ilc3.ilc_poly);
claus
parents: 332
diff changeset
  3045
			ilc3.ilc_poly = 0;
claus
parents: 332
diff changeset
  3046
		    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3047
		    last3 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3048
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3049
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3050
		ilc3.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3051
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3052
		RETURN ( (*ilc3.ilc_func)(self, aSelector, CON_COMMA nil, &ilc3, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3053
						argP[0], argP[1], argP[2]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3054
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3055
	    case 4: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3056
		if (aSelector != last4) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3057
		    ilc4.ilc_func = _SEND4;
332
claus
parents: 329
diff changeset
  3058
		    if (ilc4.ilc_poly) {
339
claus
parents: 332
diff changeset
  3059
			__flushPolyCache(ilc4.ilc_poly);
claus
parents: 332
diff changeset
  3060
			ilc4.ilc_poly = 0;
claus
parents: 332
diff changeset
  3061
		    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3062
		    last4 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3063
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3064
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3065
		ilc4.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3066
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3067
		RETURN ( (*ilc4.ilc_func)(self, aSelector, CON_COMMA nil, &ilc4,
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3068
						argP[0], argP[1], argP[2], argP[3]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3069
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3070
	    case 5: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3071
		if (aSelector != last5) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3072
		    ilc5.ilc_func = _SEND5;
332
claus
parents: 329
diff changeset
  3073
		    if (ilc5.ilc_poly) {
339
claus
parents: 332
diff changeset
  3074
			__flushPolyCache(ilc5.ilc_poly);
claus
parents: 332
diff changeset
  3075
			ilc5.ilc_poly = 0;
claus
parents: 332
diff changeset
  3076
		    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3077
		    last5 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3078
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3079
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3080
		ilc5.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3081
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3082
		RETURN ( (*ilc5.ilc_func)(self, aSelector, CON_COMMA nil, &ilc5, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3083
						argP[0], argP[1], argP[2], argP[3], argP[4]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3084
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3085
	    case 6: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3086
		if (aSelector != last6) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3087
		    ilc6.ilc_func = _SEND6;
332
claus
parents: 329
diff changeset
  3088
		    if (ilc6.ilc_poly) {
339
claus
parents: 332
diff changeset
  3089
			__flushPolyCache(ilc6.ilc_poly);
claus
parents: 332
diff changeset
  3090
			ilc6.ilc_poly = 0;
claus
parents: 332
diff changeset
  3091
		    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3092
		    last6 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3093
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3094
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3095
		ilc6.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3096
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3097
		RETURN ( (*ilc6.ilc_func)(self, aSelector, CON_COMMA nil, &ilc6, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3098
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3099
						argP[5]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3100
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3101
	    case 7: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3102
		if (aSelector != last7) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3103
		    ilc7.ilc_func = _SEND7;
332
claus
parents: 329
diff changeset
  3104
		    if (ilc7.ilc_poly) {
339
claus
parents: 332
diff changeset
  3105
			__flushPolyCache(ilc7.ilc_poly);
claus
parents: 332
diff changeset
  3106
			ilc7.ilc_poly = 0;
claus
parents: 332
diff changeset
  3107
		    }
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3108
		    last7 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3109
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3110
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3111
		ilc7.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3112
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3113
		RETURN ( (*ilc7.ilc_func)(self, aSelector, CON_COMMA nil, &ilc7, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3114
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3115
						argP[5], argP[6]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3116
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3117
	    case 8:
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3118
		if (aSelector != last8) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3119
		    ilc8.ilc_func = _SEND8;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3120
		    last8 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3121
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3122
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3123
		ilc8.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3124
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3125
		RETURN ( (*ilc8.ilc_func)(self, aSelector, CON_COMMA nil, &ilc8, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3126
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3127
						argP[5], argP[6], argP[7]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3128
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3129
	    case 9: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3130
		if (aSelector != last9) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3131
		    ilc9.ilc_func = _SEND9;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3132
		    last9 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3133
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3134
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3135
		ilc9.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3136
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3137
		RETURN ( (*ilc9.ilc_func)(self, aSelector, CON_COMMA nil, &ilc9, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3138
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3139
						argP[5], argP[6], argP[7], argP[8]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3140
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3141
	    case 10: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3142
		if (aSelector != last10) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3143
		    ilc10.ilc_func = _SEND10;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3144
		    last10 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3145
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3146
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3147
		ilc10.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3148
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3149
		RETURN ( (*ilc10.ilc_func)(self, aSelector, CON_COMMA nil, &ilc10, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3150
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3151
						argP[5], argP[6], argP[7], argP[8], argP[9]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3152
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3153
	    case 11: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3154
		if (aSelector != last11) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3155
		    ilc11.ilc_func = _SEND11;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3156
		    last11 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3157
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3158
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3159
		ilc11.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3160
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3161
		RETURN ( (*ilc11.ilc_func)(self, aSelector, CON_COMMA nil, &ilc11, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3162
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3163
						argP[5], argP[6], argP[7], argP[8], argP[9],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3164
						argP[10]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3165
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3166
	    case 12: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3167
		if (aSelector != last12) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3168
		    ilc12.ilc_func = _SEND12;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3169
		    last12 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3170
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3171
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3172
		ilc12.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3173
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3174
		RETURN ( (*ilc12.ilc_func)(self, aSelector, CON_COMMA nil, &ilc12, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3175
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3176
						argP[5], argP[6], argP[7], argP[8], argP[9],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3177
						argP[10], argP[11]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3178
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3179
	    case 13: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3180
		if (aSelector != last13) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3181
		    ilc13.ilc_func = _SEND13;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3182
		    last13 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3183
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3184
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3185
		ilc13.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3186
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3187
		RETURN ( (*ilc13.ilc_func)(self, aSelector, CON_COMMA nil, &ilc13, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3188
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3189
						argP[5], argP[6], argP[7], argP[8], argP[9],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3190
						argP[10], argP[11], argP[12]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3191
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3192
	    case 14: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3193
		if (aSelector != last14) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3194
		    ilc14.ilc_func = _SEND14;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3195
		    last14 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3196
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3197
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3198
		ilc14.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3199
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3200
		RETURN ( (*ilc14.ilc_func)(self, aSelector, CON_COMMA nil, &ilc14, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3201
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3202
						argP[5], argP[6], argP[7], argP[8], argP[9],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3203
						argP[10], argP[11], argP[12], argP[13]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3204
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3205
	    case 15: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3206
		if (aSelector != last15) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3207
		    ilc15.ilc_func = _SEND15;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3208
		    last15 = aSelector;
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3209
		}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3210
#ifdef xxTHIS_CONTEXT
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3211
		ilc15.ilc_lineNo = __pilc->ilc_lineNo;
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  3212
#endif
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3213
		RETURN ( (*ilc15.ilc_func)(self, aSelector, CON_COMMA nil, &ilc15, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3214
						argP[0], argP[1], argP[2], argP[3], argP[4],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3215
						argP[5], argP[6], argP[7], argP[8], argP[9],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3216
						argP[10], argP[11], argP[12], argP[13],
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3217
						argP[14]));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3218
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3219
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3220
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3221
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3222
    ^ self primitiveFailed
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3223
!
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3224
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3225
perform:aSelector inClass:aClass withArguments:argArray
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3226
    "send the message aSelector with all args taken from argArray 
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3227
     to the receiver as a super-send message.
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3228
     This is actually more flexible than the normal super-send, since it allows
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3229
     to execute a method in ANY superclass of the receiver (not just the
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3230
     immediate superclass).
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3231
     Thus, it is (theoretically) possible to do 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3232
	 '5 perform:#< inClass:Magnitude withArguments:#(6)'
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3233
     and evaluate Magnitudes compare method even if there was one in Number.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3234
     This method is used by the interpreter to evaluate super sends
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3235
     and could be used for very special behavior (language extension ?).
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3236
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3237
     WARNING: this is an ST/X feature - probably not found in other smalltalks."
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3238
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  3239
    |numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15|
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3240
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3241
    "
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3242
     check, if aClass is really a superclass of the receiver
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3243
    "
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3244
    (self class isSubclassOf:aClass) ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3245
	self error:'class argument is not a superclass of the receiver'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3246
	^ nil
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3247
    ].
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3248
    numberOfArgs := argArray size.
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3249
%{
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  3250
    extern OBJ Array, __AT_();
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3251
    REGISTER OBJ *argP;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3252
    int nargs, i;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3253
    static struct inlineCache ilc0 = _DUMMYILC0;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3254
    static struct inlineCache ilc1 = _DUMMYILC1;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3255
    static struct inlineCache ilc2 = _DUMMYILC2;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3256
    static struct inlineCache ilc3 = _DUMMYILC3;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3257
    static struct inlineCache ilc4 = _DUMMYILC4;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3258
    static struct inlineCache ilc5 = _DUMMYILC5;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3259
    static struct inlineCache ilc6 = _DUMMYILC6;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3260
    static struct inlineCache ilc7 = _DUMMYILC7;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3261
    static struct inlineCache ilc8 = _DUMMYILC8;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3262
    static struct inlineCache ilc9 = _DUMMYILC9;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3263
    static struct inlineCache ilc10 = _DUMMYILC10;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3264
    static struct inlineCache ilc11 = _DUMMYILC11;
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3265
    static struct inlineCache ilc12 = _DUMMYILC12;
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  3266
    static struct inlineCache ilc13 = _DUMMYILC13;
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  3267
    static struct inlineCache ilc14 = _DUMMYILC14;
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  3268
    static struct inlineCache ilc15 = _DUMMYILC15;
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3269
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  3270
    if (__isSmallInteger(numberOfArgs)) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3271
	nargs = _intVal(numberOfArgs);
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3272
	if (nargs == 0) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3273
	    RETURN (_SEND0(self, aSelector, CON_COMMA aClass, &ilc0));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3274
	}
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3275
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3276
	argP = (OBJ *)(&a1);
329
claus
parents: 325
diff changeset
  3277
	if (__Class(argArray) == Array) {
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3278
	    for (i=0; i < nargs; i++) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3279
		*argP++ = _ArrayInstPtr(argArray)->a_element[i];
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3280
	    }
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3281
	} else {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3282
	    for (i=1; i <= nargs; i++) {
443
Claus Gittinger <cg@exept.de>
parents: 438
diff changeset
  3283
		*argP++ = __AT_(argArray, CON_COMMA _MKSMALLINT(i));
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3284
	    }
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3285
	}
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3286
	switch (nargs) {
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3287
	    case 1: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3288
		RETURN ( _SEND1(self, aSelector, CON_COMMA aClass, &ilc1, a1));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3289
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3290
	    case 2: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3291
		RETURN ( _SEND2(self, aSelector, CON_COMMA aClass, &ilc2, a1, a2));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3292
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3293
	    case 3: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3294
		RETURN ( _SEND3(self, aSelector, CON_COMMA aClass, &ilc3, a1, a2, a3));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3295
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3296
	    case 4: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3297
		RETURN ( _SEND4(self, aSelector, CON_COMMA aClass, &ilc4, a1, a2, a3, a4));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3298
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3299
	    case 5: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3300
		RETURN ( _SEND5(self, aSelector, CON_COMMA aClass, &ilc5, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3301
				a1, a2, a3, a4, a5));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3302
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3303
	    case 6: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3304
		RETURN ( _SEND6(self, aSelector, CON_COMMA aClass, &ilc6, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3305
				a1, a2, a3, a4, a5, a6));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3306
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3307
	    case 7: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3308
		RETURN ( _SEND7(self, aSelector, CON_COMMA aClass, &ilc7, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3309
				a1, a2, a3, a4, a5, a6, a7));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3310
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3311
	    case 8: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3312
		RETURN ( _SEND8(self, aSelector, CON_COMMA aClass, &ilc8, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3313
				a1, a2, a3, a4, a5, a6, a7, a8));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3314
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3315
	    case 9: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3316
		RETURN ( _SEND9(self, aSelector, CON_COMMA aClass, &ilc9, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3317
				a1, a2, a3, a4, a5, a6, a7, a8, a9));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3318
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3319
	    case 10: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3320
		RETURN ( _SEND10(self, aSelector, CON_COMMA aClass, &ilc10, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3321
				 a1, a2, a3, a4, a5, a6, a7, a8, a9, a10));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3322
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3323
	    case 11: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3324
		RETURN ( _SEND11(self, aSelector, CON_COMMA aClass, &ilc11, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3325
				 a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3326
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3327
	    case 12: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3328
		RETURN ( _SEND12(self, aSelector, CON_COMMA aClass, &ilc12, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3329
				 a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3330
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3331
	    case 13: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3332
		RETURN ( _SEND13(self, aSelector, CON_COMMA aClass, &ilc13, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3333
				 a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3334
				 a13));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3335
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3336
	    case 14: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3337
		RETURN ( _SEND14(self, aSelector, CON_COMMA aClass, &ilc14, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3338
				 a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3339
				 a13, a14));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3340
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3341
	    case 15: 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3342
		RETURN ( _SEND15(self, aSelector, CON_COMMA aClass, &ilc15, 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3343
				 a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3344
				 a13, a14, a15));
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3345
	}
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3346
    }
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3347
%}
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3348
.
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3349
    ^ self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3350
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3351
2
claus
parents: 1
diff changeset
  3352
!Object methodsFor:'binary storage'!
claus
parents: 1
diff changeset
  3353
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3354
storeBinaryOn:aStream
2
claus
parents: 1
diff changeset
  3355
    "Writes a description of the receiver onto aStream, in a way that allows
claus
parents: 1
diff changeset
  3356
     the object's structure to be reconstructed from the stream's contents"
claus
parents: 1
diff changeset
  3357
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3358
    BinaryOutputManager store:self on:aStream
2
claus
parents: 1
diff changeset
  3359
!
claus
parents: 1
diff changeset
  3360
claus
parents: 1
diff changeset
  3361
hasSpecialBinaryRepresentation
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3362
    "return true, if the receiver has a special binary representation;
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3363
     default here is false, but can be redefined in class which provide
343
claus
parents: 342
diff changeset
  3364
     their own storeBinary/readBinary methods.
claus
parents: 342
diff changeset
  3365
claus
parents: 342
diff changeset
  3366
     Normal user classes should not use this, it is meant as a hook for
claus
parents: 342
diff changeset
  3367
     special classes such as True, False, UndefinedObject or SmallInteger.
claus
parents: 342
diff changeset
  3368
claus
parents: 342
diff changeset
  3369
     If your instances should be stored in a special way, see
claus
parents: 342
diff changeset
  3370
     #representBinaryOn: and #readBinaryContentsFromdata:manager:."
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3371
2
claus
parents: 1
diff changeset
  3372
    ^ false
claus
parents: 1
diff changeset
  3373
!
claus
parents: 1
diff changeset
  3374
343
claus
parents: 342
diff changeset
  3375
representBinaryOn:manager
claus
parents: 342
diff changeset
  3376
    "this method is called by the storage manager to ask objects
claus
parents: 342
diff changeset
  3377
     if they wish to provide their own binary representation.
claus
parents: 342
diff changeset
  3378
claus
parents: 342
diff changeset
  3379
     If they want to do so, they should return an array containing all
claus
parents: 342
diff changeset
  3380
     instance variables (named & indexed pointer) to be stored. 
claus
parents: 342
diff changeset
  3381
     If not redefined, this method returns nil which means that all 
claus
parents: 342
diff changeset
  3382
     instance variables are to be stored.
claus
parents: 342
diff changeset
  3383
362
claus
parents: 359
diff changeset
  3384
     It should be redefined in objects which do not want all instance variables
343
claus
parents: 342
diff changeset
  3385
     to be stored (for example: objects which keep references to a view etc.).
claus
parents: 342
diff changeset
  3386
claus
parents: 342
diff changeset
  3387
     If this is redefined returning non-nil, the corresponding class needs
claus
parents: 342
diff changeset
  3388
     a redefined instance method named #readBinaryContentsFromData:manager:
claus
parents: 342
diff changeset
  3389
     which has to fill the receivers named (and optionally indexed pointer)
claus
parents: 342
diff changeset
  3390
     instance variables with corresponding values from a data array."
claus
parents: 342
diff changeset
  3391
claus
parents: 342
diff changeset
  3392
    ^ nil
claus
parents: 342
diff changeset
  3393
362
claus
parents: 359
diff changeset
  3394
    "typical implementation:  
claus
parents: 359
diff changeset
  3395
     (see also comment in #readBinaryContentsFromData:manager:)
claus
parents: 359
diff changeset
  3396
     for an object with foo, bar and baz as instance variables,
claus
parents: 359
diff changeset
  3397
     which does not want to store baz:
claus
parents: 359
diff changeset
  3398
claus
parents: 359
diff changeset
  3399
     representBinaryOn:manager
343
claus
parents: 342
diff changeset
  3400
	|data|
claus
parents: 342
diff changeset
  3401
claus
parents: 342
diff changeset
  3402
	data := Array new:2.
claus
parents: 342
diff changeset
  3403
	data at:1 put:foo.
claus
parents: 342
diff changeset
  3404
	data at:2 put:bar.
362
claus
parents: 359
diff changeset
  3405
	^ data
343
claus
parents: 342
diff changeset
  3406
    "
claus
parents: 342
diff changeset
  3407
!
claus
parents: 342
diff changeset
  3408
claus
parents: 342
diff changeset
  3409
readBinaryContentsFromData:instvarArray manager:manager
claus
parents: 342
diff changeset
  3410
    "reconstruct the receivers instance variables by filling instance
claus
parents: 342
diff changeset
  3411
     variables with values from instvarArray. This array contains the instvars
claus
parents: 342
diff changeset
  3412
     as specified in #representBinaryOn: when the object was stored.
claus
parents: 342
diff changeset
  3413
     It is the receivers responsibility to set its instance variables in the
claus
parents: 342
diff changeset
  3414
     same order from that array."
claus
parents: 342
diff changeset
  3415
claus
parents: 342
diff changeset
  3416
    ^ self subclassResponsibility
claus
parents: 342
diff changeset
  3417
claus
parents: 342
diff changeset
  3418
    "typical implementation (see also comment in #representBinaryOn:)
claus
parents: 342
diff changeset
  3419
     (for an object with foo, bar and baz as instance variables,
claus
parents: 342
diff changeset
  3420
      which did not store baz and wants baz to be reinitialized to
claus
parents: 342
diff changeset
  3421
      some constant string)
claus
parents: 342
diff changeset
  3422
claus
parents: 342
diff changeset
  3423
	foo := instvarArray at:1.
claus
parents: 342
diff changeset
  3424
	bar := instvarArray at:2.
claus
parents: 342
diff changeset
  3425
	baz := 'aConstant'.
claus
parents: 342
diff changeset
  3426
    "
claus
parents: 342
diff changeset
  3427
!
claus
parents: 342
diff changeset
  3428
claus
parents: 342
diff changeset
  3429
storeBinaryContentsFromData:instvarArray on:stream manager:manager
claus
parents: 342
diff changeset
  3430
    "store the instvars (both named & indexed pointer)
claus
parents: 342
diff changeset
  3431
     as returned by #representBinaryOn:."
claus
parents: 342
diff changeset
  3432
claus
parents: 342
diff changeset
  3433
    |size "{ Class: SmallInteger }"|
claus
parents: 342
diff changeset
  3434
claus
parents: 342
diff changeset
  3435
    size := instvarArray size.
claus
parents: 342
diff changeset
  3436
    1 to:size do:[:i |
claus
parents: 342
diff changeset
  3437
	manager putIdOf:(instvarArray at:i) on:stream
claus
parents: 342
diff changeset
  3438
    ].
claus
parents: 342
diff changeset
  3439
!
claus
parents: 342
diff changeset
  3440
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3441
readBinaryContentsFrom:stream manager:manager
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3442
    "reconstruct the receivers instance variables by reading a binary
343
claus
parents: 342
diff changeset
  3443
     binary representation from stream. 
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  3444
     This is a general implementation, walking over instances 
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  3445
     and loading each recursively using manager.
343
claus
parents: 342
diff changeset
  3446
     Redefined by some classes to read a more compact representations
claus
parents: 342
diff changeset
  3447
     (see String, SmallInteger etc).
claus
parents: 342
diff changeset
  3448
claus
parents: 342
diff changeset
  3449
     Notice, that the object is already recreated as an empty corps
claus
parents: 342
diff changeset
  3450
     with instance variables all nil and bit-instances (bytes, words etc.) 
claus
parents: 342
diff changeset
  3451
     already read and restored.
claus
parents: 342
diff changeset
  3452
claus
parents: 342
diff changeset
  3453
     Also notice: this method is not called for if a private representation
claus
parents: 342
diff changeset
  3454
     has been stored (see representBinaryOn:). 
claus
parents: 342
diff changeset
  3455
     In that case, #readBinaryContentsFromData:manager: is called, which
claus
parents: 342
diff changeset
  3456
     has to be reimplemented in the objects class."
claus
parents: 342
diff changeset
  3457
claus
parents: 342
diff changeset
  3458
    |size "{ Class: SmallInteger }"
claus
parents: 342
diff changeset
  3459
     instvarArray|
claus
parents: 342
diff changeset
  3460
claus
parents: 342
diff changeset
  3461
    stream next == 1 ifTrue:[
claus
parents: 342
diff changeset
  3462
	"/
claus
parents: 342
diff changeset
  3463
	"/ special representation ...
claus
parents: 342
diff changeset
  3464
	"/
claus
parents: 342
diff changeset
  3465
	instvarArray := Array new:(size := stream nextNumber:3).
claus
parents: 342
diff changeset
  3466
	1 to:size do:[:i |
claus
parents: 342
diff changeset
  3467
	    instvarArray basicAt:i put:(manager nextObject)
claus
parents: 342
diff changeset
  3468
	].
claus
parents: 342
diff changeset
  3469
	self readBinaryContentsFromData:instvarArray manager:manager.
claus
parents: 342
diff changeset
  3470
	^ self
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3471
    ].
343
claus
parents: 342
diff changeset
  3472
claus
parents: 342
diff changeset
  3473
    "/
claus
parents: 342
diff changeset
  3474
    "/ standard representation
claus
parents: 342
diff changeset
  3475
    "/
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3476
    size := self basicSize.
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  3477
    size ~~ 0 ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3478
	self class isPointers ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3479
	    1 to:size do:[:i |
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3480
		self basicAt:i put:(manager nextObject)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3481
	    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3482
	]
343
claus
parents: 342
diff changeset
  3483
    ].
claus
parents: 342
diff changeset
  3484
    size := self class instSize.
claus
parents: 342
diff changeset
  3485
    1 to:size do:[:i |
claus
parents: 342
diff changeset
  3486
	self instVarAt:i put:(manager nextObject)
claus
parents: 342
diff changeset
  3487
    ].
2
claus
parents: 1
diff changeset
  3488
!
claus
parents: 1
diff changeset
  3489
343
claus
parents: 342
diff changeset
  3490
storeBinaryContentsOn:stream manager:manager
claus
parents: 342
diff changeset
  3491
    "store the receivers instance variables in a binary representation
claus
parents: 342
diff changeset
  3492
     on a stream using manager.
claus
parents: 342
diff changeset
  3493
     This is a general implementation, walking over instances 
claus
parents: 342
diff changeset
  3494
     and storing each recursively using manager.
claus
parents: 342
diff changeset
  3495
claus
parents: 342
diff changeset
  3496
     Notice, that the objects definition and bit-instances (bytes, words etc.) 
claus
parents: 342
diff changeset
  3497
     are already stored. 
claus
parents: 342
diff changeset
  3498
     Here, we only have to deal with indexed-pointer and named instance variables.
claus
parents: 342
diff changeset
  3499
claus
parents: 342
diff changeset
  3500
     Also notice: this method is not called for if a private representation
claus
parents: 342
diff changeset
  3501
     has been stored (see representBinaryOn:). 
claus
parents: 342
diff changeset
  3502
     In that case, #storeBinaryContentsFromData:manager: is called."
claus
parents: 342
diff changeset
  3503
claus
parents: 342
diff changeset
  3504
    |size "{ Class: SmallInteger }"|
claus
parents: 342
diff changeset
  3505
claus
parents: 342
diff changeset
  3506
    size := self basicSize.
claus
parents: 342
diff changeset
  3507
    size ~~ 0 ifTrue:[
claus
parents: 342
diff changeset
  3508
	self class isPointers ifTrue:[
claus
parents: 342
diff changeset
  3509
	    1 to:size do:[:i |
claus
parents: 342
diff changeset
  3510
		manager putIdOf:(self basicAt:i) on:stream
claus
parents: 342
diff changeset
  3511
	    ].
claus
parents: 342
diff changeset
  3512
	].
claus
parents: 342
diff changeset
  3513
    ].
claus
parents: 342
diff changeset
  3514
    size := self class instSize.
claus
parents: 342
diff changeset
  3515
    1 to:size do:[:i |
claus
parents: 342
diff changeset
  3516
	manager putIdOf:(self instVarAt:i) on:stream
claus
parents: 342
diff changeset
  3517
    ].
claus
parents: 342
diff changeset
  3518
!
claus
parents: 342
diff changeset
  3519
claus
parents: 342
diff changeset
  3520
storeBinaryDefinitionOn:stream manager:manager
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3521
    "append a binary representation of the receiver onto stream.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3522
     This method first stores the class, then the body, which is done
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3523
     in a separate method to allow redefinition of the bodies format.
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  3524
     Can be redefined in subclasses to write more compact representations
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  3525
     (see String, SmallInteger etc)."
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3526
343
claus
parents: 342
diff changeset
  3527
    manager putIdOfClass:(self class) on:stream.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3528
    self storeBinaryDefinitionBodyOn:stream manager:manager
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3529
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3530
343
claus
parents: 342
diff changeset
  3531
storeBinaryDefinitionBodyOn:stream manager:manager
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3532
    "append a binary representation of the receivers body onto stream.
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3533
     This is a general implementation walking over instances storing
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3534
     each recursively as an ID using manager.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3535
     Can be redefined in subclasses."
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3536
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3537
    |basicSize "{ Class: SmallInteger }"
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3538
     instSize  "{ Class: SmallInteger }"
343
claus
parents: 342
diff changeset
  3539
     myClass specialRep|
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3540
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3541
    myClass := self class.
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3542
    instSize := myClass instSize.
343
claus
parents: 342
diff changeset
  3543
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3544
    myClass isPointers ifTrue:[
343
claus
parents: 342
diff changeset
  3545
	"/
claus
parents: 342
diff changeset
  3546
	"/ inst size not needed - if you uncomment the line below,
claus
parents: 342
diff changeset
  3547
	"/ also uncomment the corresponding line in
claus
parents: 342
diff changeset
  3548
	"/ Object>>binaryDefinitionFrom:manager:
claus
parents: 342
diff changeset
  3549
	"/
claus
parents: 342
diff changeset
  3550
	"/ stream nextPut:instSize. "mhmh this limits us to 255 named instvars"
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3551
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3552
	myClass isVariable ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3553
	    stream nextNumber:3 put:(basicSize := self basicSize)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3554
	] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3555
	    basicSize := 0
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3556
	].
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3557
    ] ifFalse: [
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3558
	stream nextNumber:4 put:(basicSize := self basicSize).
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3559
	myClass isBytes ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3560
	    1 to:basicSize do:[:i |
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3561
		stream nextPut:(self basicAt:i)
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3562
	    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3563
	] ifFalse:[
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3564
	    myClass isWords ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3565
		1 to:basicSize do:[:i |
343
claus
parents: 342
diff changeset
  3566
		    stream nextNumber:2 put:(self basicAt: i)
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3567
		]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3568
	    ] ifFalse:[
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3569
		myClass isLongs ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3570
		    1 to:basicSize do:[:i |
343
claus
parents: 342
diff changeset
  3571
			stream nextNumber:4 put:(self basicAt: i)
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3572
		    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3573
		] ifFalse:[
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3574
		    myClass isFloats ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3575
			"could do it in one big write on machines which use IEEE floats ..."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3576
			1 to:basicSize do:[:i |
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3577
			    Float storeBinaryIEEESingle:(self basicAt:i) on:stream
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3578
			]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3579
		    ] ifFalse:[
179
51c8ee007268 *** empty log message ***
claus
parents: 159
diff changeset
  3580
			myClass isDoubles ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3581
			    "could do it in one big write on machines which use IEEE doubles ..."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3582
			    1 to:basicSize do:[:i |
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3583
				Float storeBinaryIEEEDouble:(self basicAt:i) on:stream
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3584
			    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3585
			] ifFalse:[
343
claus
parents: 342
diff changeset
  3586
			    "/ should never be reached ...
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3587
			    1 to:basicSize do:[:i |
343
claus
parents: 342
diff changeset
  3588
				manager putIdOf:(self basicAt:i) on:stream
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3589
			    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3590
			]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3591
		    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3592
		]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3593
	    ]
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3594
	].
343
claus
parents: 342
diff changeset
  3595
    ].
claus
parents: 342
diff changeset
  3596
claus
parents: 342
diff changeset
  3597
    specialRep := self representBinaryOn:manager.
claus
parents: 342
diff changeset
  3598
    specialRep notNil ifTrue:[
362
claus
parents: 359
diff changeset
  3599
	stream nextPut:1.     "/ means: private representation follows
343
claus
parents: 342
diff changeset
  3600
	stream nextNumber:3 put:(specialRep basicSize).
claus
parents: 342
diff changeset
  3601
	self storeBinaryContentsFromData:specialRep on:stream manager:manager
claus
parents: 342
diff changeset
  3602
    ] ifFalse:[
362
claus
parents: 359
diff changeset
  3603
	stream nextPut:0.     "/ means: full representation follows
343
claus
parents: 342
diff changeset
  3604
	self storeBinaryContentsOn:stream manager:manager
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3605
    ]
2
claus
parents: 1
diff changeset
  3606
!
claus
parents: 1
diff changeset
  3607
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3608
storeBinaryOn:stream manager:manager
39
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3609
    "append a binary representation of the receiver onto stream."
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3610
bcf183a31bbb *** empty log message ***
claus
parents: 33
diff changeset
  3611
    manager putIdOf:self on:stream
2
claus
parents: 1
diff changeset
  3612
! !
claus
parents: 1
diff changeset
  3613
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3614
!Object methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3615
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3616
className
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3617
    "return the classname of the receivers class"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3618
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3619
    ^ self class name
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3620
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3621
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3622
     1 className
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3623
     1 class className   'this may change ...'
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3624
     $a className
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3625
     $a class className  'this may change ...'
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3626
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3627
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3628
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3629
classNameWithArticle
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3630
    "return a string consisting of classname preceeded by an article.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3631
     (dont expect me to write national variants for this ... :-)
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3632
     If you have special preferences, redefine it ..."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3633
85
claus
parents: 77
diff changeset
  3634
    |classname|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3635
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3636
    classname := self class displayString.
85
claus
parents: 77
diff changeset
  3637
    ^ classname article , ' ' , classname
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3638
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3639
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3640
     1 classNameWithArticle
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3641
     (1->2) classNameWithArticle
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3642
     XWorkstation basicNew classNameWithArticle
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3643
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3644
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3645
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3646
printOn:aStream
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3647
    "print the receiver on the argument-stream.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3648
     The default here is to output the receivers class name.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3649
     BUT: this method is heavily redefined for objects which
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3650
     can print prettier."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3651
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3652
    aStream nextPutAll:self classNameWithArticle
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3653
!
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3654
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3655
print
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3656
    "print the receiver on the standard output stream"
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3657
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3658
    self printOn:Stdout
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3659
!
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3660
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3661
printNewline
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3662
    "print the receiver followed by a cr on the standard output stream"
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3663
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3664
    self printOn:Stdout.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3665
    Stdout cr
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3666
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3667
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3668
printNL
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3669
    "print the receiver followed by a cr on the standard output stream
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3670
     - for GNU Smalltalk compatibility"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3671
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3672
    ^ self printNewline
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3673
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3674
356
claus
parents: 348
diff changeset
  3675
infoPrint
claus
parents: 348
diff changeset
  3676
    "print the receiver on the standard error stream.
claus
parents: 348
diff changeset
  3677
     This is meant for information messages which are not warnings
claus
parents: 348
diff changeset
  3678
     or fatal messages.
claus
parents: 348
diff changeset
  3679
     These messages can be turned on/off by 'Object infoPrinting:true/false'"
claus
parents: 348
diff changeset
  3680
claus
parents: 348
diff changeset
  3681
    InfoPrinting ifTrue:[
claus
parents: 348
diff changeset
  3682
	self printOn:Stderr
claus
parents: 348
diff changeset
  3683
    ]
claus
parents: 348
diff changeset
  3684
!
claus
parents: 348
diff changeset
  3685
claus
parents: 348
diff changeset
  3686
infoPrintNL
claus
parents: 348
diff changeset
  3687
    "print the receiver followed by a cr on the standard error stream.
claus
parents: 348
diff changeset
  3688
     This is meant for information messages which are not warnings
claus
parents: 348
diff changeset
  3689
     or fatal messages.
claus
parents: 348
diff changeset
  3690
     These messages can be turned on/off by 'Object infoPrinting:true/false'"
claus
parents: 348
diff changeset
  3691
claus
parents: 348
diff changeset
  3692
    InfoPrinting ifTrue:[
claus
parents: 348
diff changeset
  3693
	self errorPrintNewline
claus
parents: 348
diff changeset
  3694
    ]
claus
parents: 348
diff changeset
  3695
!
claus
parents: 348
diff changeset
  3696
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3697
errorPrint
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3698
    "print the receiver on the standard error stream."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3699
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3700
    self printOn:Stderr
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3701
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3702
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3703
errorPrintNewline
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3704
    "print the receiver followed by a cr on the standard error stream"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3705
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3706
    self printOn:Stderr.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3707
    Stderr cr
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3708
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3709
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3710
errorPrintNL
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3711
    "print the receiver followed by a cr on the standard error stream"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3712
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3713
    ^ self errorPrintNewline
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3714
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3715
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3716
printString
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3717
    "return a string for printing the receiver.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3718
     Since we now use printOn: as the basic print mechanism,
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3719
     we have to create a stream and print into it."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3720
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3721
    |s|
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3722
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3723
    s := WriteStream on:(String new:30).
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3724
    self printOn:s.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3725
    ^ s contents
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3726
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3727
369
claus
parents: 362
diff changeset
  3728
printStringPaddedTo:size with:padCharacter ifLarger:alternative
claus
parents: 362
diff changeset
  3729
    "return a printed representation of the receiver,
claus
parents: 362
diff changeset
  3730
     padded with padCharacter (at the right) up to size.
claus
parents: 362
diff changeset
  3731
     If the resulting printString is too large, 
claus
parents: 362
diff changeset
  3732
     return the result from evaluating alternative."
claus
parents: 362
diff changeset
  3733
claus
parents: 362
diff changeset
  3734
    |s|
claus
parents: 362
diff changeset
  3735
claus
parents: 362
diff changeset
  3736
    s := self printString.
claus
parents: 362
diff changeset
  3737
    s size > size ifTrue:[^ alternative value].
claus
parents: 362
diff changeset
  3738
    ^ s paddedTo:size with:padCharacter
claus
parents: 362
diff changeset
  3739
claus
parents: 362
diff changeset
  3740
    "
claus
parents: 362
diff changeset
  3741
     123   printStringPaddedTo:3 with:$. ifLarger:['***']
claus
parents: 362
diff changeset
  3742
     12345 printStringPaddedTo:3 with:$. ifLarger:['***']
claus
parents: 362
diff changeset
  3743
    "
claus
parents: 362
diff changeset
  3744
!
claus
parents: 362
diff changeset
  3745
2
claus
parents: 1
diff changeset
  3746
printStringPaddedTo:size with:padCharacter
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3747
    "return a printed representation of the receiver,
369
claus
parents: 362
diff changeset
  3748
     padded with padCharacter (at the right) up to size.
claus
parents: 362
diff changeset
  3749
     If the printString is longer than size, 
claus
parents: 362
diff changeset
  3750
     it is returned unchanged (i.e. not truncated)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3751
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3752
    ^ (self printString) paddedTo:size with:padCharacter
2
claus
parents: 1
diff changeset
  3753
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3754
    "
369
claus
parents: 362
diff changeset
  3755
     123  printStringPaddedTo:10 with:$.
claus
parents: 362
diff changeset
  3756
     123  printStringPaddedTo:10 with:$*
claus
parents: 362
diff changeset
  3757
     123  printStringPaddedTo:3 with:$*   
claus
parents: 362
diff changeset
  3758
     1234 printStringPaddedTo:3 with:$*   
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3759
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3760
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3761
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3762
printStringPaddedTo:size
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3763
    "return a printed representation of the receiver,
369
claus
parents: 362
diff changeset
  3764
     padded with spaces (at the right) up to size.
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3765
     If the printString is longer than size, 
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3766
     it is returned unchanged (i.e. not truncated)"
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3767
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3768
    ^ self printStringPaddedTo:size with:(Character space)
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3769
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3770
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3771
     123 printStringPaddedTo:10    
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3772
     1234567890123456 printStringPaddedTo:10  
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3773
     'hello' printStringPaddedTo:10   
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3774
    "
2
claus
parents: 1
diff changeset
  3775
!
claus
parents: 1
diff changeset
  3776
369
claus
parents: 362
diff changeset
  3777
printStringPaddedTo:size ifLarger:alternative
claus
parents: 362
diff changeset
  3778
    "return a printed representation of the receiver,
claus
parents: 362
diff changeset
  3779
     padded with spaces (at the right) up to size.
claus
parents: 362
diff changeset
  3780
     If the resulting printString is too large, 
claus
parents: 362
diff changeset
  3781
     return the result from evaluating alternative."
claus
parents: 362
diff changeset
  3782
claus
parents: 362
diff changeset
  3783
    ^ self printStringPaddedTo:size with:(Character space) ifLarger:alternative
claus
parents: 362
diff changeset
  3784
claus
parents: 362
diff changeset
  3785
    "
claus
parents: 362
diff changeset
  3786
     12   printStringPaddedTo:3 ifLarger:['***']   
claus
parents: 362
diff changeset
  3787
     123  printStringPaddedTo:3 ifLarger:['***']   
claus
parents: 362
diff changeset
  3788
     1234 printStringPaddedTo:3 ifLarger:['***']   
claus
parents: 362
diff changeset
  3789
    "
claus
parents: 362
diff changeset
  3790
!
claus
parents: 362
diff changeset
  3791
2
claus
parents: 1
diff changeset
  3792
printStringZeroPaddedTo:size
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3793
    "return a printed representation of the receiver, 
369
claus
parents: 362
diff changeset
  3794
     padded with zero (at the right) characters up to size.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3795
     Usually used with float numbers."
2
claus
parents: 1
diff changeset
  3796
claus
parents: 1
diff changeset
  3797
    ^ self printStringPaddedTo:size with:$0
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3798
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3799
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3800
     123.0 printStringZeroPaddedTo:10 
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3801
    "
2
claus
parents: 1
diff changeset
  3802
!
claus
parents: 1
diff changeset
  3803
369
claus
parents: 362
diff changeset
  3804
printStringLeftPaddedTo:size with:padCharacter ifLarger:alternative
claus
parents: 362
diff changeset
  3805
    "return my printString as a right-adjusted string of length size;
claus
parents: 362
diff changeset
  3806
     characters on the left are filled with padCharacter.
claus
parents: 362
diff changeset
  3807
     If the printString is larger than size,
claus
parents: 362
diff changeset
  3808
     return the result from evaluating alternative."
claus
parents: 362
diff changeset
  3809
claus
parents: 362
diff changeset
  3810
    |s|
claus
parents: 362
diff changeset
  3811
claus
parents: 362
diff changeset
  3812
    s := self printString.
claus
parents: 362
diff changeset
  3813
    s size > size ifTrue:[^ alternative value].
claus
parents: 362
diff changeset
  3814
    ^ s leftPaddedTo:size with:padCharacter
claus
parents: 362
diff changeset
  3815
claus
parents: 362
diff changeset
  3816
    "
claus
parents: 362
diff changeset
  3817
     12   printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
claus
parents: 362
diff changeset
  3818
     123  printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
claus
parents: 362
diff changeset
  3819
     1234 printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
claus
parents: 362
diff changeset
  3820
    "
claus
parents: 362
diff changeset
  3821
!
claus
parents: 362
diff changeset
  3822
2
claus
parents: 1
diff changeset
  3823
printStringLeftPaddedTo:size with:padCharacter
claus
parents: 1
diff changeset
  3824
    "return my printString as a right-adjusted string of length size;
369
claus
parents: 362
diff changeset
  3825
     characters on the left are filled with padCharacter.
claus
parents: 362
diff changeset
  3826
     If the printString is longer than size, 
claus
parents: 362
diff changeset
  3827
     it is returned unchanged (i.e. not truncated)"
2
claus
parents: 1
diff changeset
  3828
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3829
    ^ (self printString) leftPaddedTo:size with:padCharacter
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3830
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3831
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3832
     123 printStringLeftPaddedTo:10 with:$.   
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3833
     1 printStringLeftPaddedTo:10 with:$.      
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3834
     (Float pi) printStringLeftPaddedTo:20 with:$*
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3835
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3836
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3837
369
claus
parents: 362
diff changeset
  3838
printStringLeftPaddedTo:size ifLarger:alternative
claus
parents: 362
diff changeset
  3839
    "return my printString as a right-adjusted string of length size;
claus
parents: 362
diff changeset
  3840
     characters on the left are filled with spaces.
claus
parents: 362
diff changeset
  3841
     If the printString is larger than size,
claus
parents: 362
diff changeset
  3842
     return the result from evaluating alternative."
claus
parents: 362
diff changeset
  3843
claus
parents: 362
diff changeset
  3844
    ^ self printStringLeftPaddedTo:size with:(Character space) ifLarger:alternative
claus
parents: 362
diff changeset
  3845
claus
parents: 362
diff changeset
  3846
    "
claus
parents: 362
diff changeset
  3847
     12   printStringLeftPaddedTo:3 ifLarger:['***']
claus
parents: 362
diff changeset
  3848
     123  printStringLeftPaddedTo:3 ifLarger:['***']
claus
parents: 362
diff changeset
  3849
     1234 printStringLeftPaddedTo:3 ifLarger:['***']
claus
parents: 362
diff changeset
  3850
    "
claus
parents: 362
diff changeset
  3851
!
claus
parents: 362
diff changeset
  3852
2
claus
parents: 1
diff changeset
  3853
printStringLeftPaddedTo:size
claus
parents: 1
diff changeset
  3854
    "return my printString as a right-adjusted string of length size;
369
claus
parents: 362
diff changeset
  3855
     characters on the left are filled with spaces.
claus
parents: 362
diff changeset
  3856
     If the printString is longer than size, 
claus
parents: 362
diff changeset
  3857
     it is returned unchanged (i.e. not truncated)"
2
claus
parents: 1
diff changeset
  3858
claus
parents: 1
diff changeset
  3859
    ^ self printStringLeftPaddedTo:size with:(Character space)
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3860
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3861
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3862
     10 printStringLeftPaddedTo:10
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3863
     1 printStringLeftPaddedTo:10
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3864
    "
2
claus
parents: 1
diff changeset
  3865
!
claus
parents: 1
diff changeset
  3866
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3867
printOn:aStream paddedTo:size with:padCharacter
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3868
    "print the receiver on aStream, padding with padCharacter up to size"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3869
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3870
    aStream nextPutAll:(self printStringPaddedTo:size with:padCharacter).
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3871
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3872
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3873
     123 printOn:Transcript paddedTo:10 with:$_ . Transcript cr
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3874
     123 printOn:Transcript paddedTo:10 with:$. . Transcript cr
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3875
    "
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3876
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3877
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3878
printOn:aStream zeroPaddedTo:size
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3879
    "print the receiver on aStream, padding with zeros up to size.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3880
     Usually used with float numbers."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3881
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3882
    self printOn:aStream paddedTo:size with:$0.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3883
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3884
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3885
     123.0 printOn:Transcript zeroPaddedTo:10
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3886
    "
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3887
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3888
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3889
printOn:aStream paddedTo:size
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3890
    "print the receiver on aStream, padding with spaces up to size."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3891
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3892
    self printOn:aStream paddedTo:size with:(Character space)
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3893
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3894
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3895
     123.0 printOn:Transcript paddedTo:10. Transcript nextPut:$|. Transcript cr
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3896
    "
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3897
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3898
2
claus
parents: 1
diff changeset
  3899
printOn:aStream leftPaddedTo:size with:padCharacter
claus
parents: 1
diff changeset
  3900
    "print the receiver on aStream, padding with padCharacters up to size.
claus
parents: 1
diff changeset
  3901
     padding is done on the left."
claus
parents: 1
diff changeset
  3902
claus
parents: 1
diff changeset
  3903
    aStream nextPutAll:(self printStringLeftPaddedTo:size with:padCharacter)
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3904
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3905
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3906
     123 printOn:Transcript leftPaddedTo:10 with:$_ . Transcript cr
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3907
     123 printOn:Transcript leftPaddedTo:10 with:$. . Transcript cr
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3908
    "
2
claus
parents: 1
diff changeset
  3909
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3910
2
claus
parents: 1
diff changeset
  3911
printOn:aStream leftPaddedTo:size
claus
parents: 1
diff changeset
  3912
    "print the receiver on aStream, padding with spaces up to size.
claus
parents: 1
diff changeset
  3913
     padding is done on the left."
claus
parents: 1
diff changeset
  3914
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3915
    self printOn:aStream leftPaddedTo:size with:(Character space)
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3916
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3917
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3918
     123 printOn:Transcript leftPaddedTo:10. Transcript cr
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3919
     123 printOn:Transcript leftPaddedTo:2. Transcript cr
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3920
    "
2
claus
parents: 1
diff changeset
  3921
!
claus
parents: 1
diff changeset
  3922
claus
parents: 1
diff changeset
  3923
printStringRightAdjustLen:size
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3924
    "obsolete - just a name confusion.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3925
     This method will go away ..."
2
claus
parents: 1
diff changeset
  3926
claus
parents: 1
diff changeset
  3927
    ^ self printStringLeftPaddedTo:size
claus
parents: 1
diff changeset
  3928
!
claus
parents: 1
diff changeset
  3929
claus
parents: 1
diff changeset
  3930
printRightAdjustLen:size
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3931
    "obsolete - just a name confusion.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3932
     This method will go away ..."
2
claus
parents: 1
diff changeset
  3933
claus
parents: 1
diff changeset
  3934
    (self printStringLeftPaddedTo:size) printOn:Stdout
claus
parents: 1
diff changeset
  3935
!
claus
parents: 1
diff changeset
  3936
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3937
displayString
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3938
    "return a string used when displaying the receiver in a view;
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3939
     for example an Inspector. This is usually the same as printString,
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3940
     but sometimes redefined for a better look."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3941
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3942
    ^ self printString
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3943
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3944
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3945
     #(1 2 3) printString    
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3946
     #(1 2 3) displayString  
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3947
     #(1 2 3) storeString
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3948
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3949
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3950
308
f04744ef7b5d *** empty log message ***
claus
parents: 298
diff changeset
  3951
displayOn:aGc x:x y:y
f04744ef7b5d *** empty log message ***
claus
parents: 298
diff changeset
  3952
    "display the receiver in a graphicsContext - this method allows
f04744ef7b5d *** empty log message ***
claus
parents: 298
diff changeset
  3953
     for any object to be displayed in a ListView - for example."
f04744ef7b5d *** empty log message ***
claus
parents: 298
diff changeset
  3954
f04744ef7b5d *** empty log message ***
claus
parents: 298
diff changeset
  3955
    ^ aGc displayString:(self displayString) x:x y:y.
f04744ef7b5d *** empty log message ***
claus
parents: 298
diff changeset
  3956
!
f04744ef7b5d *** empty log message ***
claus
parents: 298
diff changeset
  3957
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3958
storeOn:aStream
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3959
    "store the receiver on aStream; i.e. print an expression which will
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3960
     reconstruct the receiver.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3961
     Notice, that no self referencing or cyclic objects can be represented
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3962
     in this format.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  3963
     Use storeBinaryOn:, which handles these cases correctly."
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3964
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3965
    |myClass hasSemi sz "{ Class: SmallInteger }" |
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3966
25
e34a6267c79b *** empty log message ***
claus
parents: 13
diff changeset
  3967
    thisContext isRecursive ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3968
	Transcript showCr:'Error: storeString of self referencing object.'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3969
	aStream nextPutAll:'#("recursive")'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3970
	^ self
25
e34a6267c79b *** empty log message ***
claus
parents: 13
diff changeset
  3971
    ].
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3972
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3973
    myClass := self class.
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3974
    aStream nextPut:$(.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3975
    aStream nextPutAll:self class name.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3976
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3977
    hasSemi := false.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3978
    myClass isVariable ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3979
	aStream nextPutAll:' basicNew:'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3980
	self basicSize printOn:aStream
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3981
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3982
	aStream nextPutAll:' basicNew'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3983
    ].
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  3984
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3985
    sz := myClass instSize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3986
    1 to:sz do:[:i | 
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3987
	aStream nextPutAll:' instVarAt:'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3988
	i printOn:aStream.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3989
	aStream nextPutAll:' put:'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3990
	(self instVarAt:i) storeOn:aStream.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3991
	aStream nextPut:$;.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3992
	hasSemi := true
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3993
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3994
    myClass isVariable ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3995
	sz := self basicSize.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3996
	1 to:sz do:[:i | 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3997
	    aStream nextPutAll:' basicAt:'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3998
	    i printOn:aStream.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  3999
	    aStream nextPutAll:' put:'.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  4000
	    (self basicAt:i) storeOn:aStream.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  4001
	    aStream nextPut:$;.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  4002
	    hasSemi := true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  4003
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4004
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4005
    hasSemi ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  4006
	aStream nextPutAll:' yourself'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4007
    ].
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  4008
    aStream nextPut:$).
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4009
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4010
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4011
     |s|
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4012
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4013
     s := WriteStream on:(String new).
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4014
     ('hello' -> 'world') storeOn:s.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4015
     s := ReadStream on:(s contents).
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4016
     (Object readFrom:s) inspect
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4017
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4018
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4019
     |s|
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4020
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4021
     s := 'data' asFilename writeStream.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4022
     ('hello' -> 'world') storeOn:s.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4023
     s close.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4024
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4025
     s := 'data' asFilename readStream.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4026
     (Object readFrom:s) inspect
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4027
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4028
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4029
    "does not work example:"
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4030
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4031
     |s a|
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4032
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4033
     a := Array new:2.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4034
     a at:1 put:a.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4035
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4036
     s := 'data' asFilename writeStream.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4037
     a storeOn:s.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4038
     s close.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4039
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4040
     s := 'data' asFilename readStream.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4041
     (Object readFrom:s) inspect
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4042
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4043
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4044
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  4045
storeString
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4046
    "return a string representing an expression to reconstruct the receiver.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4047
     Notice, that no self referencing or cyclic objects can be represented
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4048
     in this format.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  4049
     Use storeBinaryOn:, which handles these cases correctly."
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  4050
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  4051
    |s|
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  4052
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  4053
    s := WriteStream on:(String new:50).
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  4054
    self storeOn:s.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  4055
    ^ s contents
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4056
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4057
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4058
store
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  4059
    "store the receiver on standard output.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  4060
     this method is useless, but included for compatibility."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4061
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4062
    self storeOn:Stdout
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4063
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4064
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4065
storeNl
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  4066
    "store the receiver on standard output; append a newline.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  4067
     this method is useless, but included for compatibility."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4068
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4069
    self store.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4070
    Character nl print
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4071
! !