Object.st
author Claus Gittinger <cg@exept.de>
Fri, 07 Jul 2000 16:13:34 +0200
changeset 5449 bf1de72fd2bb
parent 5424 3ffaef20cfd0
child 5452 71fd110c347a
permissions -rw-r--r--
preps for rel5 migration
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
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
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
5354
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
    13
"{ Package: 'stx:libbasic' }"
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
    14
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
    15
nil subclass:#Object
5367
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    16
	instanceVariableNames:''
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    17
	classVariableNames:'ErrorSignal HaltSignal MessageNotUnderstoodSignal
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    18
		UserInterruptSignal RecursionInterruptSignal
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    19
		ExceptionInterruptSignal SubscriptOutOfBoundsSignal
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    20
		IndexNotFoundSignal NonIntegerIndexSignal NotFoundSignal
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    21
		KeyNotFoundSignal ElementOutOfBoundsSignal UserNotificationSignal
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    22
		InformationSignal WarningSignal PrimitiveFailureSignal
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    23
		DeepCopyErrorSignal AbortSignal ErrorRecursion Dependencies
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    24
		InfoPrinting ActivityNotificationSignal InternalErrorSignal
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    25
		NonWeakDependencies SynchronizationSemaphores ObjectAttributes
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    26
		OSSignalInterruptSignal FinalizationLobby'
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    27
	poolDictionaries:''
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
    28
	category:'Kernel-Objects'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    29
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    30
1788
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
    31
!Object class methodsFor:'documentation'!
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
    32
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
 COPYRIGHT (c) 1988 by Claus Gittinger
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
    36
              All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    45
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    47
dependencies
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    48
"
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    49
   ST/X dependencies are slightly modified from ST-80's 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    50
   (we think they are better ;-).
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    51
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    52
   One problem occuring very often in ST-80 is that some object
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    53
   cannot be garbage collected because some dependency is present,
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    54
   having the object as a dependent of some other object.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    55
   In ST-80, this association remains alive (because a Dictionary
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    56
   is used to hold dependents) - even if no other references exist to
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    57
   to dependent or the dependee.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    58
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    59
   This means, that in ST-80, a #release is mandatory in order to
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    60
   prevent memory leaks.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    61
   We think, that this is a bad solution, since after all, exactly that
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    62
   kind of work should be performed by a garbage collector - you should not
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    63
   need to care about dependencies.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    64
   From a philosophical point of view, why should some object depend on 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    65
   something that the programmer considers a dead object ?
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    66
   (well - worse than that: it seems that some ST-80 code even depends on
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    67
    that behavior)
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    68
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    69
   In order to limit the trouble, ST-80 reimplemented the way dependents
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    70
   are stored in the model class - this one keeps the dependents locally,
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    71
   so these dependents go away, once the model is reclaimed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    72
   That may make things even more confusing: with models, no #release is
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    73
   needed, with general objects it is mandatory.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    74
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    75
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    76
   In ST/X, dependencies are implemented using a WeakDictionary; this means,
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    77
   that once the dependee dies, the dependency association is removed automatically,
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    78
   and the dependent can be reclaimed by the garbage collector, if no other
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    79
   references exist to the dependent.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    80
   In order to (at least) provide a mechanism for the old behavior
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    81
   (in case your application heavily depends on the ST-80 mechanism), complementary
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    82
   protocol to add nonWeak dependencies is provided 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    83
   (see #addNonWeakDependent / #removeNonWeakDependent).
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    84
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    85
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    86
   Caveat:
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
    87
      since interests are implemented using InterestConverter (which are simply
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    88
      forwarding messages), these must use the nonWeak mechanism (as done in ST-80
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    89
      automatically).
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    90
      The reason is that there are usually no direct references to the converters,
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    91
      and those would be reclaimed if stored in a weakDictionary.
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
    92
      This means, that those interests MUST be removed with #retractInterest
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    93
      (which is bug-compatible to ST-80). 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    94
      We rewrite things to provide a more convenient mechanism in the future ...
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    95
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    96
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    97
   I like to hear comments on the above - do you think its better ?
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    98
"
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
    99
!
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   100
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   101
documentation
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   102
"
1294
e26bbb61f6b2 documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
   103
   Object is the superclass of most other classes. 
e26bbb61f6b2 documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
   104
   (except for nil-subclasses, which inherit nothing,
e26bbb61f6b2 documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
   105
    to catch any message into their #doesNotUnderstand: method)
e26bbb61f6b2 documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
   106
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   107
   Protocol which is common to every object is defined here.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   108
   Also some utility stuff (like notify) and error handling is implemented here.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   109
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   110
   Object has no instance variables (and may not get any added). One reason is, that
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   111
   UndefinedObject and SmallInteger are also inheriting from Object - these two cannot 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   112
   have instance variables (due to their implementation). 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   113
   The other reason is that the runtime system (VM) knows about the layout of some built-in 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   114
   classes (think of Class, Method, Block and also Integer or Float). 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   115
   If you were allowed to add instance variables to Object, the VM had to be recompiled 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   116
   (and also rewritten in some places).
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   117
1294
e26bbb61f6b2 documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
   118
   [Class variables:]
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   119
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   120
        ErrorSignal     <Signal>        Signal raised for error/error: messages
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   121
                                        also, parent of all other signals.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   122
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   123
        HaltSignal      <Signal>        Signal raised for halt/halt: messages
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   124
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   125
        MessageNotUnderstoodSignal      Signals raised for various error conditions
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   126
        UserInterruptSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   127
        RecursionInterruptSignal 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   128
        ExceptionInterruptSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   129
        SubscriptOutOfBoundsSignal 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   130
        NonIntegerIndexSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   131
        NotFoundSignal 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   132
        KeyNotFoundSignal 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   133
        ElementOutOfBoundsSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   134
        InformationSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   135
        WarningSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   136
        DeepCopyErrorSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   137
        InternalErrorSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   138
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   139
        AbortSignal      <Signal>       Signal raised by debugger, to abort a computation
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   140
                                        BUT, the debugger will only raise it if it is handled.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   141
                                        By handling the abortSignal, you can control where the
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   142
                                        debuggers abort-function resumes execution in case of
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   143
                                        an error.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   144
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   145
        ErrorRecursion   <Boolean>      controls behavior when recursive errors occur (i.e. 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   146
                                        an error while handling an error).
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   147
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   148
        Dependencies     <WeakDependencyDictionary>  
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   149
                                        keeps track of object dependencies.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   150
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   151
        InfoPrinting     <Boolean>      controls weather informational messages 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   152
                                        are printed.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   153
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   154
        ActivityNotificationSignal <QuerySignal> 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   155
                                         raised on #activityNotification:
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   156
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   157
        NonWeakDependencies <Dictionary> keeps track of object dependencies.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   158
                                         Dependents stay alive.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   159
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   160
        SynchronizationSemaphores <WeakIdentityDictionary>
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   161
                                         Semaphores for per-object-monitor.
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
   162
                                        
1294
e26bbb61f6b2 documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
   163
e26bbb61f6b2 documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
   164
    [author:]
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   165
        Claus Gittinger
1294
e26bbb61f6b2 documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
   166
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   167
"
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
   168
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   169
1788
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
   170
!Object class methodsFor:'initialization'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   171
a27a279701f8 Initial revision
claus
parents:
diff changeset
   172
initialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
    "called only once - initialize signals"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   174
a27a279701f8 Initial revision
claus
parents:
diff changeset
   175
    ErrorSignal isNil ifTrue:[
4520
57362111e454 ErrorSignal is now the class based exception Error.
Stefan Vogel <sv@exept.de>
parents: 4499
diff changeset
   176
        ErrorSignal := Error.
3999
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   177
4866
c2b3ca7c0e70 HaltSignal (and BreakpointSignal) is no longer a child of Error.
Claus Gittinger <cg@exept.de>
parents: 4858
diff changeset
   178
        HaltSignal := Exception newSignalMayProceed:true.
3999
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   179
        HaltSignal nameClass:self message:#haltSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   180
        HaltSignal notifierString:'halt encountered'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   181
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   182
        MessageNotUnderstoodSignal := ErrorSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   183
        MessageNotUnderstoodSignal nameClass:self message:#messageNotUnderstoodSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   184
        MessageNotUnderstoodSignal notifierString:'message not understood'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   185
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   186
        PrimitiveFailureSignal := ErrorSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   187
        PrimitiveFailureSignal nameClass:self message:#primitiveFailureSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   188
        PrimitiveFailureSignal notifierString:'primitive failed'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   189
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   190
        InternalErrorSignal := ErrorSignal newSignalMayProceed:false.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   191
        InternalErrorSignal nameClass:self message:#internalErrorSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   192
        InternalErrorSignal notifierString:'VM internal error: '.
2227
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
   193
362
claus
parents: 359
diff changeset
   194
"/        UserInterruptSignal := ErrorSignal newSignalMayProceed:true.
3999
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   195
        UserInterruptSignal := (Signal new) mayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   196
        UserInterruptSignal nameClass:self message:#userInterruptSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   197
        UserInterruptSignal notifierString:'user Interrupt'.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   198
362
claus
parents: 359
diff changeset
   199
"/        RecursionInterruptSignal := ErrorSignal newSignalMayProceed:false.
3999
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   200
        RecursionInterruptSignal := (Signal new) mayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   201
        RecursionInterruptSignal nameClass:self message:#recursionInterruptSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   202
        RecursionInterruptSignal notifierString:'recursion limit reached'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   203
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   204
        ExceptionInterruptSignal := ErrorSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   205
        ExceptionInterruptSignal nameClass:self message:#exceptionInterruptSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   206
        ExceptionInterruptSignal notifierString:'exception Interrupt'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   207
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   208
        NotFoundSignal := ErrorSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   209
        NotFoundSignal nameClass:self message:#notFoundSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   210
        NotFoundSignal notifierString:'no such element'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   211
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   212
        IndexNotFoundSignal := NotFoundSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   213
        IndexNotFoundSignal nameClass:self message:#indexNotFoundSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   214
        IndexNotFoundSignal notifierString:'bad index: '.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   215
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   216
        SubscriptOutOfBoundsSignal := IndexNotFoundSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   217
        SubscriptOutOfBoundsSignal nameClass:self message:#subscriptOutOfBoundsSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   218
        SubscriptOutOfBoundsSignal notifierString:'subscript out of bounds: '.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   219
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   220
        ElementOutOfBoundsSignal := ErrorSignal newSignalMayProceed:false.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   221
        ElementOutOfBoundsSignal nameClass:self message:#elementOutOfBoundsSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   222
        ElementOutOfBoundsSignal notifierString:'element not appropriate or out of bounds'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   223
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   224
        KeyNotFoundSignal := NotFoundSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   225
        KeyNotFoundSignal nameClass:self message:#keyNotFoundSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   226
        KeyNotFoundSignal notifierString:'no such key: '.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   227
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   228
        NonIntegerIndexSignal := IndexNotFoundSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   229
        NonIntegerIndexSignal nameClass:self message:#nonIntegerIndexSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   230
        NonIntegerIndexSignal notifierString:'index must be integer'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   231
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   232
        UserNotificationSignal := QuerySignal new.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   233
        UserNotificationSignal nameClass:self message:#userNotificationSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   234
        UserNotificationSignal notifierString:'user notifiaction wanted'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   235
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   236
        InformationSignal := UserNotificationSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   237
        InformationSignal nameClass:self message:#informationSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   238
        InformationSignal notifierString:'information'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   239
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   240
        WarningSignal := UserNotificationSignal newSignalMayProceed:true.
4053
eb3063f80058 Fix typo: warnungSignal
Stefan Vogel <sv@exept.de>
parents: 4009
diff changeset
   241
        WarningSignal nameClass:self message:#warningSignal.
3999
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   242
        WarningSignal notifierString:'warning'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   243
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   244
        ActivityNotificationSignal := UserNotificationSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   245
        ActivityNotificationSignal nameClass:self message:#activityNotificationSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   246
        ActivityNotificationSignal notifierString:'activity'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   247
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   248
        DeepCopyErrorSignal := ErrorSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   249
        DeepCopyErrorSignal nameClass:self message:#deepCopyErrorSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   250
        DeepCopyErrorSignal notifierString:'object cannot be deepCopy-ed'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   251
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   252
        "
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   253
         AbortSignal is not a child of ErrorSignal -
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   254
         this would complicate abort from within a signal handler
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   255
        "
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   256
        AbortSignal := Signal genericSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   257
        AbortSignal nameClass:self message:#abortSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   258
        AbortSignal notifierString:'unhandled abort signal'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   259
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   260
        "
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   261
         OSSignalInterruptSignal is not a child of ErrorSignal -
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   262
         it requires explicit catching.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   263
         If unhandled, a debugger is entered.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   264
        "
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   265
        OSSignalInterruptSignal := Signal genericSignal newSignalMayProceed:true.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   266
        OSSignalInterruptSignal nameClass:self message:#osSignalInterruptSignal.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   267
        OSSignalInterruptSignal notifierString:'OS signal interrupt'.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   268
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   269
        ObjectAttributes isNil ifTrue:[
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   270
            ObjectAttributes := WeakIdentityDictionary new.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   271
        ].
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   272
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   273
        Dependencies isNil ifTrue:[
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   274
            Dependencies := WeakDependencyDictionary new.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   275
        ].
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   276
        NonWeakDependencies isNil ifTrue:[
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   277
            NonWeakDependencies := IdentityDictionary new.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   278
        ].
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   279
        SynchronizationSemaphores isNil ifTrue:[
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   280
            SynchronizationSemaphores := WeakIdentityDictionary new.
57e83b6efee1 SubscriptOutOfBounds signal is raised proceedable,
Stefan Vogel <sv@exept.de>
parents: 3994
diff changeset
   281
        ].
356
claus
parents: 348
diff changeset
   282
    ].
2114
706cf3f9019a initialize InfoPrinting flag from VM's setting
Claus Gittinger <cg@exept.de>
parents: 2096
diff changeset
   283
4873
1642bad0297f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4866
diff changeset
   284
    FinalizationLobby isNil ifTrue:[
1642bad0297f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4866
diff changeset
   285
        FinalizationLobby := Registry new.
1642bad0297f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4866
diff changeset
   286
    ].
1642bad0297f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4866
diff changeset
   287
2114
706cf3f9019a initialize InfoPrinting flag from VM's setting
Claus Gittinger <cg@exept.de>
parents: 2096
diff changeset
   288
    "/ initialize InfoPrinting to the VM's infoPrint setting
706cf3f9019a initialize InfoPrinting flag from VM's setting
Claus Gittinger <cg@exept.de>
parents: 2096
diff changeset
   289
    "/ (which can be turned off via a command line argument)
706cf3f9019a initialize InfoPrinting flag from VM's setting
Claus Gittinger <cg@exept.de>
parents: 2096
diff changeset
   290
    InfoPrinting := ObjectMemory infoPrinting.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   291
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
    "Object initialize"
812
00db9c0646fe notificationsignals are no longer children of ErrorSignal
Claus Gittinger <cg@exept.de>
parents: 783
diff changeset
   293
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
   294
    "Modified: / 22.1.1998 / 21:23:40 / av"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
   295
    "Modified: / 3.2.1998 / 18:55:09 / cg"
4520
57362111e454 ErrorSignal is now the class based exception Error.
Stefan Vogel <sv@exept.de>
parents: 4499
diff changeset
   296
    "Modified: / 4.8.1999 / 08:54:06 / stefan"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   297
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   298
4873
1642bad0297f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4866
diff changeset
   299
!Object class methodsFor:'Compatibility - ST80'!
3175
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   300
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   301
rootError
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   302
    "return the signal used for error/error: - handling.
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   303
     Same as errorSignal for ST80 compatibility."
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   304
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   305
    ^ ErrorSignal
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   306
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   307
    "Created: / 15.1.1998 / 23:47:05 / stefan"
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   308
! !
b0181a625671 #rootError for ST80 compatibility (same as errorSignal)
Stefan Vogel <sv@exept.de>
parents: 3159
diff changeset
   309
1788
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
   310
!Object class methodsFor:'Signal constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   311
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   312
abortSignal 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   313
    "return the signal used to abort user actions. This signal is only
2689
ada9b102abcf typo fix
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   314
     raised if caught (by the debugger), and will lead way out of the
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   315
     currently active doIt/printIt or inspectIt. (also some others use
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   316
     this for a save abort)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   317
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   318
    ^ AbortSignal
579
2d26193415b5 allow catching of information: and warn: boxes
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   319
!
2d26193415b5 allow catching of information: and warn: boxes
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   320
782
86f091b2635e activityNotification added
Claus Gittinger <cg@exept.de>
parents: 781
diff changeset
   321
activityNotificationSignal
86f091b2635e activityNotification added
Claus Gittinger <cg@exept.de>
parents: 781
diff changeset
   322
    "return the signal used for activity notifications.
86f091b2635e activityNotification added
Claus Gittinger <cg@exept.de>
parents: 781
diff changeset
   323
     A handler for this signal gets all #activityNotification: sends"
86f091b2635e activityNotification added
Claus Gittinger <cg@exept.de>
parents: 781
diff changeset
   324
86f091b2635e activityNotification added
Claus Gittinger <cg@exept.de>
parents: 781
diff changeset
   325
    ^ ActivityNotificationSignal
86f091b2635e activityNotification added
Claus Gittinger <cg@exept.de>
parents: 781
diff changeset
   326
!
86f091b2635e activityNotification added
Claus Gittinger <cg@exept.de>
parents: 781
diff changeset
   327
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   328
deepCopyErrorSignal 
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   329
    "return the signal raised when a deepcopy is asked for
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   330
     an object which cannot do this (for example, BlockClosures
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   331
     or Contexts)."
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   332
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   333
    ^ DeepCopyErrorSignal
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   334
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   335
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   336
elementOutOfBoundsSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   337
    "return the signal used for element error reporting
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   338
     (this signal is used for example when a value not in 0..255 is to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   339
      be put into a bytearray)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   340
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   341
    ^ ElementOutOfBoundsSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   342
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   343
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   344
errorSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   345
    "return the signal used for error/error: - handling"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   346
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   347
    ^ ErrorSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   348
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   349
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   350
exceptionInterruptSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   351
    "return the signal used for exception (display errors) error handling"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   352
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   353
    ^ ExceptionInterruptSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   354
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   355
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   356
haltSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   357
    "return the signal used for halt/halt: - handling"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   358
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   359
    ^ HaltSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   360
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   361
3101
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   362
indexNotFoundSignal
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   363
    "return the signal used for bad index error reporting.
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   364
     This is also the parentSignal of the nonIntegerIndex- and
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   365
     subscriptOutOfBoundsSignal"
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   366
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   367
    ^ IndexNotFoundSignal
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   368
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   369
    "Created: / 8.11.1997 / 19:15:48 / cg"
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   370
!
6bb441e14a95 added indexNotFoundSignal (ST80 compat)
Claus Gittinger <cg@exept.de>
parents: 3078
diff changeset
   371
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   372
informationSignal 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   373
    "return the signal used for informations. 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   374
     A handler for this signal gets all #information: sends"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   375
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   376
    ^ InformationSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   377
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   378
2227
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
   379
internalErrorSignal
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
   380
    "return the signal used to report internal (VM-) errors."
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
   381
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
   382
    ^ InternalErrorSignal
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
   383
!
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
   384
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   385
keyNotFoundSignal 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   386
    "return the signal used for no such key error reporting"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   387
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   388
    ^ KeyNotFoundSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   389
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   390
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   391
messageNotUnderstoodSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   392
    "return the signal used for doesNotUnderstand: - error handling"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   393
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   394
    ^ MessageNotUnderstoodSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   395
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   396
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   397
nonIntegerIndexSignal 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   398
    "return the signal used for bad subscript error reporting"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   399
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   400
    ^ NonIntegerIndexSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   401
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   402
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   403
notFoundSignal 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   404
    "return the signal used for no element found error reporting"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   405
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   406
    ^ NotFoundSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   407
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   408
3423
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
   409
osSignalInterruptSignal 
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
   410
    "return the signal used for OS-signal error reporting;
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
   411
     This is only raised if handled - otherwise, a debugger is entered."
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
   412
3557
b7eb2a1cb593 oops OSSignalInterruptSignal
Claus Gittinger <cg@exept.de>
parents: 3466
diff changeset
   413
    ^ OSSignalInterruptSignal
b7eb2a1cb593 oops OSSignalInterruptSignal
Claus Gittinger <cg@exept.de>
parents: 3466
diff changeset
   414
b7eb2a1cb593 oops OSSignalInterruptSignal
Claus Gittinger <cg@exept.de>
parents: 3466
diff changeset
   415
    "Modified: / 12.6.1998 / 16:27:26 / cg"
3423
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
   416
!
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
   417
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   418
primitiveFailureSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   419
    "return the signal used for primitiveFailed - error handling"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   420
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   421
    ^ PrimitiveFailureSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   422
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   423
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   424
privateMethodSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   425
    "return the signal used for privateMethod - error handling"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   426
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   427
    ^ MessageNotUnderstoodSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   428
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   429
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   430
recursionInterruptSignal 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   431
    "return the signal used for recursion overflow error handling"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   432
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   433
    ^ RecursionInterruptSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   434
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   435
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   436
subscriptOutOfBoundsSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   437
    "return the signal used for subscript error reporting.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   438
     (this signal is used for example when an array is accessed with an
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   439
      index less than 1 or greater than the array size)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   440
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   441
    ^ SubscriptOutOfBoundsSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   442
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   443
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   444
userInterruptSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   445
    "return the signal used for ^C interrupts handling"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   446
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   447
    ^ UserInterruptSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   448
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   449
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   450
userNotificationSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   451
    "the parent signal used with information and warnings.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   452
     Handling this allows handling of both information- and warning notifications."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   453
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   454
    ^ UserNotificationSignal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   455
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   456
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   457
warningSignal 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   458
    "return the signal used for warnings.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   459
     A handler for this signal gets all #warn: sends"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   460
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   461
    ^ WarningSignal
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   462
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   463
1788
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
   464
!Object class methodsFor:'info messages'!
356
claus
parents: 348
diff changeset
   465
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   466
infoPrinting
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   467
    "return the flag which controls information messages."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   468
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   469
    ^ InfoPrinting
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   470
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   471
356
claus
parents: 348
diff changeset
   472
infoPrinting:aBoolean
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
   473
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
   474
356
claus
parents: 348
diff changeset
   475
    "turn on/off printing of information messages.
claus
parents: 348
diff changeset
   476
     If the argument, aBoolean is false, infoPrint will not output
claus
parents: 348
diff changeset
   477
     messages. The default is true."
claus
parents: 348
diff changeset
   478
claus
parents: 348
diff changeset
   479
    InfoPrinting := aBoolean
claus
parents: 348
diff changeset
   480
! !
claus
parents: 348
diff changeset
   481
1788
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
   482
!Object class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   483
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   484
isBuiltInClass
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   485
    "return true, if this class is known by the run-time-system,
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   486
     i.e. you cannot add/remove instance variables without recompiling
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   487
     the VM.
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   488
     Here, true is returned for myself, false for subclasses."
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   489
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   490
    ^ self == Object
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   491
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1260
diff changeset
   492
    "Modified: 23.4.1996 / 16:00:07 / cg"
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   493
! !
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   494
5307
568d242fcf3a VW5i compatibility
Claus Gittinger <cg@exept.de>
parents: 5270
diff changeset
   495
!Object methodsFor:'Compatibility - ST80'!
568d242fcf3a VW5i compatibility
Claus Gittinger <cg@exept.de>
parents: 5270
diff changeset
   496
568d242fcf3a VW5i compatibility
Claus Gittinger <cg@exept.de>
parents: 5270
diff changeset
   497
isMetaclass
568d242fcf3a VW5i compatibility
Claus Gittinger <cg@exept.de>
parents: 5270
diff changeset
   498
    ^ self isMeta
568d242fcf3a VW5i compatibility
Claus Gittinger <cg@exept.de>
parents: 5270
diff changeset
   499
! !
568d242fcf3a VW5i compatibility
Claus Gittinger <cg@exept.de>
parents: 5270
diff changeset
   500
4858
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   501
!Object methodsFor:'Compatibility - Squeak'!
4587
58c780c70318 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4574
diff changeset
   502
4991
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   503
asString
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   504
    ^ self printString
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   505
!
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   506
4587
58c780c70318 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4574
diff changeset
   507
clone
58c780c70318 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4574
diff changeset
   508
    ^ self shallowCopy
4982
adfc8977cee4 more Squeak compatibility
ps
parents: 4884
diff changeset
   509
!
adfc8977cee4 more Squeak compatibility
ps
parents: 4884
diff changeset
   510
4991
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   511
currentHand
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   512
        "Return a usable HandMorph -- the one associated with the object's current environment.  This method will always return a hand, even if it has to conjure one up as a last resort.  If a particular hand is actually handling events at the moment (such as a remote hand or a ghost hand), it will be returned."
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   513
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   514
        | w |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   515
        ^ (w _ self currentWorld) activeHand ifNil: [w hands first]!
4991
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   516
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   517
currentWorld
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   518
        ^ Utilities currentWorld
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   519
!
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   520
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   521
newTileMorphRepresentative
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   522
        ^ TileMorph new setLiteral: self!
4991
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   523
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   524
stringForReadout
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   525
        ^ self stringRepresentation!
4991
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   526
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   527
stringRepresentation
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   528
        "Answer a string that represents the receiver.  For most objects this is simply its printString, but for strings themselves, it's themselves.  6/12/96 sw"
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   529
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   530
        ^ self printString !
4991
b326c2cfe076 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4982
diff changeset
   531
4982
adfc8977cee4 more Squeak compatibility
ps
parents: 4884
diff changeset
   532
veryDeepCopy
adfc8977cee4 more Squeak compatibility
ps
parents: 4884
diff changeset
   533
adfc8977cee4 more Squeak compatibility
ps
parents: 4884
diff changeset
   534
     ^(self deepCopyUsing:(IdentityDictionary new)) postDeepCopyFrom:self
4587
58c780c70318 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4574
diff changeset
   535
! !
58c780c70318 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4574
diff changeset
   536
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   537
!Object methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   538
a27a279701f8 Initial revision
claus
parents:
diff changeset
   539
at:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
   540
    "return the indexed instance variable with index, anInteger;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   541
     this method can be redefined in subclasses."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   542
a27a279701f8 Initial revision
claus
parents:
diff changeset
   543
    ^ self basicAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
   544
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   545
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   546
at:index put:anObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   547
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   548
     this method can be redefined in subclasses. Returns anObject (sigh)"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   549
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   550
    ^ self basicAt:index put:anObject
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   551
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   552
    "Modified: 19.4.1996 / 11:13:29 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   553
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
   554
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   555
basicAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
   556
    "return the indexed instance variable with index, anInteger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   557
     Trigger an error if the receiver has no indexed instance variables.
2148
f0a95dd96db5 comment
Claus Gittinger <cg@exept.de>
parents: 2147
diff changeset
   558
     This method should NOT be redefined in any subclass (except with great care, for tuning)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   559
a27a279701f8 Initial revision
claus
parents:
diff changeset
   560
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   561
329
claus
parents: 325
diff changeset
   562
    REGISTER int nbytes, indx;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   563
    OBJ myClass;
329
claus
parents: 325
diff changeset
   564
    REGISTER char *pFirst;
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   565
#ifdef alpha64
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
   566
#   define int32        int
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   567
#else
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
   568
#   define int32        long
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   569
#endif
329
claus
parents: 325
diff changeset
   570
    REGISTER int n;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   571
a27a279701f8 Initial revision
claus
parents:
diff changeset
   572
    /*
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   573
     * notice the missing test for self being a nonNilObject -
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   574
     * this can be done since basicAt: is defined both in UndefinedObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   575
     * and SmallInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   576
     */
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
   577
    if (__isSmallInteger(index)) {
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   578
        myClass = __qClass(self);
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   579
        indx = __intVal(index) - 1;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   580
        n /* nInstVars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   581
        n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   582
        nbytes = __qSize(self) - n /* nInstBytes */;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   583
        pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   584
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   585
        switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   586
            case __MASKSMALLINT(POINTERARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   587
            case __MASKSMALLINT(WKPOINTERARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   588
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   589
                 * pointers
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   590
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   591
                if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   592
                    OBJ *op;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   593
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   594
                    op = (OBJ *)pFirst + indx;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   595
                    RETURN ( *op );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   596
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   597
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   598
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   599
            case __MASKSMALLINT(BYTEARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   600
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   601
                 * (unsigned) bytes
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   602
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   603
                if ((unsigned)indx < nbytes) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   604
                    unsigned char *cp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   605
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   606
                    cp = (unsigned char *)pFirst + indx;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   607
                    RETURN ( __MKSMALLINT(*cp & 0xFF) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   608
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   609
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   610
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   611
            case __MASKSMALLINT(FLOATARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   612
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   613
                 * native floats
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   614
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   615
                if ((unsigned)indx < (nbytes / sizeof(float))) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   616
                    float *fp;
4858
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   617
                    float f;
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   618
                    OBJ v;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   619
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   620
                    fp = (float *)pFirst + indx;
4858
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   621
                    f = *fp;
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   622
                    if (f == 0.0) {
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   623
                        v = __float0;
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   624
                    } else {
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   625
                        __qMKSFLOAT(v, f);
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   626
                    }
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   627
                    RETURN (v);
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   628
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   629
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   630
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   631
            case __MASKSMALLINT(DOUBLEARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   632
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   633
                 * native doubles
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   634
                 */
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   635
#ifdef __NEED_DOUBLE_ALIGN
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   636
                if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   637
                    int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   638
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   639
                    pFirst += delta;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   640
                    nbytes -= delta;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   641
                }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   642
#endif
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   643
                if ((unsigned)indx < (nbytes / sizeof(double))) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   644
                    double *dp;
4858
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   645
                    double d;
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   646
                    OBJ v;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   647
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   648
                    dp = (double *)pFirst + indx;
4858
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   649
                    d = *dp;
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   650
                    if (d == 0.0) {
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   651
                        v = __float0;
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   652
                    } else {
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   653
                        __qMKFLOAT(v, d);
8f3ed29a8fe0 quicker 0-return from float- and doubleArray
Claus Gittinger <cg@exept.de>
parents: 4818
diff changeset
   654
                    }
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   655
                    RETURN (v);
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   656
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   657
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   658
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   659
            case __MASKSMALLINT(WORDARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   660
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   661
                 * unsigned 16bit ints
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   662
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   663
                /* Notice: the hard coded shifts are by purpose;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   664
                 * it makes us independent of the short-size of the machine
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   665
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   666
                if ((unsigned)indx < (nbytes>>1)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   667
                    unsigned short *sp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   668
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   669
                    sp = (unsigned short *)(pFirst + (indx<<1));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   670
                    RETURN ( __MKSMALLINT(*sp & 0xFFFF) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   671
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   672
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   673
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   674
            case __MASKSMALLINT(SWORDARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   675
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   676
                 * signed 16bit ints
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   677
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   678
                /* Notice: the hard coded shifts are by purpose;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   679
                 * it makes us independent of the short-size of the machine
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   680
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   681
                if ((unsigned)indx < (nbytes>>1)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   682
                    short *ssp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   683
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   684
                    ssp = (short *)(pFirst + (indx<<1));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   685
                    RETURN ( __MKSMALLINT(*ssp) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   686
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   687
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   688
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   689
            case __MASKSMALLINT(LONGARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   690
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   691
                 * unsigned 32bit ints
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   692
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   693
                /* Notice: the hard coded shifts are by purpose;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   694
                 * it makes us independent of the int-size of the machine
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   695
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   696
                if ((unsigned)indx < (nbytes>>2)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   697
                    unsigned int32 ul;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   698
                    unsigned int32 *lp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   699
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   700
                    lp = (unsigned int32 *)(pFirst + (indx<<2));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   701
                    ul = *lp;
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   702
#ifdef alpha64
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   703
                    {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   704
                        unsigned  INT ull = (unsigned INT)ul;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   705
                        RETURN ( __MKSMALLINT(ull) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   706
                    }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   707
#else
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   708
                    if (ul <= _MAX_INT) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   709
                        RETURN ( __MKSMALLINT(ul) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   710
                    }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   711
                    RETURN ( __MKULARGEINT(ul) );
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   712
#endif
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   713
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   714
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   715
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   716
            case __MASKSMALLINT(SLONGARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   717
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   718
                 * signed 32bit ints
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   719
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   720
                /* Notice: the hard coded shifts are by purpose;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   721
                 * it makes us independent of the int-size of the machine
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   722
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   723
                if ((unsigned)indx < (nbytes>>2)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   724
                    int32 *slp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   725
                    int32 l;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   726
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   727
                    slp = (int32 *)(pFirst + (indx<<2));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   728
                    l = *slp;
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   729
#ifdef alpha64
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   730
                    {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   731
                        INT ll = (INT)l;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   732
                        RETURN ( __MKSMALLINT(ll) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   733
                    }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   734
#else
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   735
                    if (__ISVALIDINTEGER(l)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   736
                        RETURN ( __MKSMALLINT(l) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   737
                    }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   738
                    RETURN ( __MKLARGEINT(l) );
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   739
#endif
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   740
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   741
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   742
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   743
            case __MASKSMALLINT(SLONGLONGARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   744
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   745
                 * signed 64bit longlongs
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   746
                 */
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   747
#ifdef __NEED_LONGLONG_ALIGN
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   748
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   749
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   750
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   751
                    pFirst += delta;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   752
                    nbytes -= delta;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   753
                }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   754
#endif
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   755
                /* Notice: the hard coded shifts are by purpose;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   756
                 * it makes us independent of the long/longlong-size of the machine
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   757
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   758
                if ((unsigned)indx < (nbytes>>3)) {
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   759
#ifdef alpha64
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   760
                    INT *slp, ll;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   761
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   762
                    slp = (INT *)(pFirst + (indx<<3));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   763
                    ll = *slp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   764
                    if (__ISVALIDINTEGER(ll)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   765
                        RETURN ( __MKSMALLINT(ll) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   766
                    }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   767
                    RETURN ( __MKLARGEINT(ll) );
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   768
#else
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   769
                    __int64__ *llp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   770
                    extern OBJ __MKINT64();
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   771
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   772
                    llp = (__int64__ *)(pFirst + (indx<<3));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   773
                    RETURN (__MKINT64(llp));
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   774
#endif
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   775
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   776
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   777
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   778
            case __MASKSMALLINT(LONGLONGARRAY):
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   779
                /*
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   780
                 * unsigned 64bit longlongs
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   781
                 */
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   782
#ifdef __NEED_LONGLONG_ALIGN
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   783
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   784
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   785
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   786
                    pFirst += delta;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   787
                    nbytes -= delta;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   788
                }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   789
#endif
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   790
                /* Notice: the hard coded shifts are by purpose;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   791
                 * it makes us independent of the long/longlong-size of the machine
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   792
                 */
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   793
                if ((unsigned)indx < (nbytes>>3)) {
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   794
#ifdef alpha64
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   795
                    unsigned INT *ulp, ul;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   796
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   797
                    ulp = (unsigned INT *)(pFirst + (indx<<3));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   798
                    ul = *ulp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   799
                    if (ul <= _MAX_INT) {
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   800
                        RETURN ( __MKSMALLINT(ul) );
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   801
                    }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   802
                    RETURN ( __MKULARGEINT(ul) );
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   803
#else
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   804
                    __uint64__ *llp;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   805
                    extern OBJ __MKUINT64();
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   806
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   807
                    llp = (__uint64__ *)(pFirst + (indx<<3));
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   808
                    RETURN (__MKUINT64(llp));
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   809
#endif
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   810
                }
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   811
                break;
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   812
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   813
    }
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   814
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   815
#   undef int32
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   816
1386
a31cecccdfd8 _MASKSMALLINT -> __MASKSMALLINT;
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   817
%}.
10
claus
parents: 5
diff changeset
   818
    index isInteger ifFalse:[
4220
f4cbb12b74dd alpha64 fix
Claus Gittinger <cg@exept.de>
parents: 4208
diff changeset
   819
        ^ self indexNotInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   820
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
   821
    ^ self subscriptBoundsError:index
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   822
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   823
a27a279701f8 Initial revision
claus
parents:
diff changeset
   824
basicAt:index put:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   825
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   826
     Returns anObject (sigh).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   827
     Trigger an error if the receiver has no indexed instance variables.
2148
f0a95dd96db5 comment
Claus Gittinger <cg@exept.de>
parents: 2147
diff changeset
   828
f0a95dd96db5 comment
Claus Gittinger <cg@exept.de>
parents: 2147
diff changeset
   829
     This method should NOT be redefined in any subclass (except with great care, for tuning)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   830
a27a279701f8 Initial revision
claus
parents:
diff changeset
   831
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   832
a27a279701f8 Initial revision
claus
parents:
diff changeset
   833
    register int nbytes, indx;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   834
    OBJ myClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   835
    register char *pFirst;
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   836
#ifdef alpha64
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
   837
#   define int32        int
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   838
#else
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
   839
#   define int32        long
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   840
#endif
329
claus
parents: 325
diff changeset
   841
/*    int nInstBytes, ninstvars, flags; */
claus
parents: 325
diff changeset
   842
    REGISTER int n;
1515
49a8587fcc8f added support for signedWord and signedLong indexable classes.
Claus Gittinger <cg@exept.de>
parents: 1445
diff changeset
   843
    unsigned int u;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   844
    int val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   845
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
   846
    /* notice the missing test for self being a nonNilObject -
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
   847
       this can be done since basicAt: is defined both in UndefinedObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   848
       and SmallInteger */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   849
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
   850
    if (__isSmallInteger(index)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   851
        indx = __intVal(index) - 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   852
        myClass = __qClass(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   853
        n /* ninstvars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   854
        n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   855
        nbytes = __qSize(self) - n /* nInstBytes */;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   856
        pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   857
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   858
        switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   859
            case __MASKSMALLINT(POINTERARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   860
            case __MASKSMALLINT(WKPOINTERARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   861
                if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   862
                    OBJ *op;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   863
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   864
                    op = (OBJ *)pFirst + indx;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   865
                    *op = anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   866
                    __STORE(self, anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   867
                    RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   868
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   869
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   870
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   871
            case __MASKSMALLINT(BYTEARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   872
                if (__isSmallInteger(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   873
                    val = __intVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   874
                    if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   875
                        if ((unsigned)indx < nbytes) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   876
                            char *cp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   877
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   878
                            cp = pFirst + indx;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   879
                            *cp = val;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   880
                            RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   881
                        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   882
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   883
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   884
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   885
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   886
            case __MASKSMALLINT(FLOATARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   887
                if ((unsigned)indx < (nbytes / sizeof(float))) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   888
                    float *fp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   889
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   890
                    fp = (float *)pFirst + indx;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   891
                    if (anObject != nil) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   892
                        if (! __isSmallInteger(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   893
                            if (__qIsFloatLike(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   894
                                *fp = (float)(__floatVal(anObject));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   895
                                RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   896
                            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   897
                            if (__qIsShortFloat(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   898
                                *fp = __shortFloatVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   899
                                RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   900
                            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   901
                        } else {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   902
                            *fp = (float) __intVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   903
                            RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   904
                        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   905
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   906
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   907
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   908
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   909
            case __MASKSMALLINT(DOUBLEARRAY):
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   910
#ifdef __NEED_DOUBLE_ALIGN
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   911
                if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   912
                    int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   913
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   914
                    pFirst += delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   915
                    nbytes -= delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   916
                }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
   917
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   918
                if ((unsigned)indx < (nbytes / sizeof(double))) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   919
                    double *dp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   920
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   921
                    dp = (double *)pFirst + indx;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   922
                    if (anObject != nil) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   923
                        if (! __isSmallInteger(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   924
                            if (__qIsFloatLike(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   925
                                *dp = __floatVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   926
                                RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   927
                            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   928
                            if (__qIsShortFloat(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   929
                                *dp = (double)__shortFloatVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   930
                                RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   931
                            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   932
                        } else {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   933
                            *dp = (double) __intVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   934
                            RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   935
                        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   936
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   937
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   938
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   939
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   940
            case __MASKSMALLINT(WORDARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   941
                if (__isSmallInteger(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   942
                    val = __intVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   943
                    if ((unsigned)val <= 0xFFFF) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   944
                        if ((unsigned)indx < (nbytes>>1)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   945
                            unsigned short *sp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   946
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   947
                            sp = (unsigned short *)(pFirst + (indx<<1));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   948
                            *sp = val;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   949
                            RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   950
                        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   951
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   952
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   953
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   954
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   955
            case __MASKSMALLINT(SWORDARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   956
                if (__isSmallInteger(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   957
                    val = __intVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   958
                    if ((val >= -32768) && (val < 32768)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   959
                        if ((unsigned)indx < (nbytes>>1)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   960
                            short *ssp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   961
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   962
                            ssp = (short *)(pFirst + (indx<<1));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   963
                            *ssp = val;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   964
                            RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   965
                        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   966
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   967
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   968
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   969
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   970
            case __MASKSMALLINT(SLONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   971
                if ((unsigned)indx < (nbytes>>2)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   972
                    int32 *slp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   973
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   974
                    slp = (int32 *)(pFirst + (indx<<2));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   975
                    if (__isSmallInteger(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   976
                        *slp = __intVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   977
                        RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   978
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   979
                    n = __signedLongIntVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   980
                    /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   981
                     * zero means failure for an int larger than 4 bytes 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   982
                     * (would be a smallInteger) 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   983
                     */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   984
                    if (n) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   985
                        *slp = n;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   986
                        RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   987
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   988
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   989
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   990
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   991
            case __MASKSMALLINT(LONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   992
                if ((unsigned)indx < (nbytes>>2)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   993
                    unsigned int32 *lp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   994
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   995
                    lp = (unsigned int32 *)(pFirst + (indx<<2));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   996
                    if (anObject == __MKSMALLINT(0)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   997
                        *lp = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   998
                        RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
   999
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1000
                    u = __longIntVal(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1001
                    /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1002
                     * zero means failure for an int larger than 4 bytes
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1003
                     * (would be a smallInteger)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1004
                     */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1005
                    if (u) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1006
                        *lp = u;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1007
                        RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1008
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1009
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1010
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1011
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1012
            case __MASKSMALLINT(SLONGLONGARRAY):
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  1013
#ifdef __NEED_LONGLONG_ALIGN
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1014
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1015
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1016
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1017
                    pFirst += delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1018
                    nbytes -= delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1019
                }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  1020
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1021
                if ((unsigned)indx < (nbytes>>3)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1022
                    __int64__ ll;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1023
                    __int64__ *sllp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1024
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1025
                    sllp = (__int64__ *)(pFirst + (indx<<3));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1026
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1027
                    if (anObject == __MKSMALLINT(0)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1028
                        ll.lo = ll.hi = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1029
                        *sllp = ll;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1030
                        RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1031
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1032
                    if (__signedLong64IntVal(anObject, &ll)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1033
                        *sllp = ll;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1034
                        RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1035
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1036
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1037
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1038
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1039
            case __MASKSMALLINT(LONGLONGARRAY):
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  1040
#ifdef __NEED_LONGLONG_ALIGN
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1041
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1042
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1043
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1044
                    pFirst += delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1045
                    nbytes -= delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1046
                }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  1047
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1048
                if ((unsigned)indx < (nbytes>>3)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1049
                    __uint64__ ll;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1050
                    __uint64__ *llp;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1051
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1052
                    llp = (__uint64__ *)(pFirst + (indx<<3));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1053
                    if (anObject == __MKSMALLINT(0)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1054
                        ll.lo = ll.hi = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1055
                        *llp = ll;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1056
                        RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1057
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1058
                    if (__unsignedLong64IntVal(anObject, &ll)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1059
                        *llp = ll;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1060
                        RETURN ( anObject );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1061
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1062
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1063
                break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1064
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1065
    }
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1066
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1067
#   undef int32
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1068
1386
a31cecccdfd8 _MASKSMALLINT -> __MASKSMALLINT;
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1069
%}.
10
claus
parents: 5
diff changeset
  1070
    index isInteger ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1071
        "
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1072
         the index should be an integer number
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1073
        "
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1074
        ^ self indexNotInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1075
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1076
    (index between:1 and:self size) ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1077
        "
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1078
         the index is less than 1 or greater than the size of the
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1079
         receiver collection
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1080
        "
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1081
        ^ self subscriptBoundsError:index
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1082
    ].
643
04b2025af0e3 use new isFLoatsOrDoubles
Claus Gittinger <cg@exept.de>
parents: 594
diff changeset
  1083
    (self class isFloatsOrDoubles) ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1084
        anObject isNumber ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1085
            ^ self basicAt:index put:(anObject asFloat)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1086
        ]
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1087
    ].
10
claus
parents: 5
diff changeset
  1088
    anObject isInteger ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1089
        "
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1090
         the object to put into the receiver collection
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1091
         should be an integer number
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1092
        "
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1093
        ^ self elementNotInteger
2
claus
parents: 1
diff changeset
  1094
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1095
    "
213
3b56a17534fd *** empty log message ***
claus
parents: 202
diff changeset
  1096
     the object to put into the receiver collection
362
claus
parents: 359
diff changeset
  1097
     is not an instance of the expected element class,
claus
parents: 359
diff changeset
  1098
     or the value is  not within the elements valid range.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1099
    "
2
claus
parents: 1
diff changeset
  1100
    ^ self elementBoundsError
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1101
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1102
    "Modified: 19.4.1996 / 11:14:10 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1103
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1104
2574
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1105
byteAt:index
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1106
    "return the byte at index. 
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1107
     This is only allowed for non-pointer indexed objects
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1108
     (i.e. byteArrays, wordArrays, floatArrays etc.).
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1109
     The receivers indexed instvars are treated as an uninterpreted
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1110
     collection of bytes.
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1111
     Only useful with binary storage."
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1112
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1113
%{  /* NOCONTEXT */
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1114
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1115
    REGISTER int indx;
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1116
    int nIndex;
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1117
    REGISTER OBJ slf;
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1118
    REGISTER OBJ cls;
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1119
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1120
    if (__isSmallInteger(index)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1121
        slf = self;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1122
        if (__isNonNilObject(slf)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1123
            unsigned char *pFirst;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1124
            int nIndex;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1125
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1126
            cls = __qClass(slf);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1127
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1128
            pFirst = __ByteArrayInstPtr(slf)->ba_element;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1129
            pFirst += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1130
            nIndex = __byteArraySize(slf);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1131
            indx = __intVal(index) - 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1132
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1133
            switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1134
                case __MASKSMALLINT(DOUBLEARRAY):
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  1135
#ifdef __NEED_DOUBLE_ALIGN
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1136
                    if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1137
                        int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1138
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1139
                        pFirst += delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1140
                        nIndex -= delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1141
                    }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  1142
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1143
                    /* fall into */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1144
                case __MASKSMALLINT(BYTEARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1145
                case __MASKSMALLINT(WORDARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1146
                case __MASKSMALLINT(LONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1147
                case __MASKSMALLINT(SWORDARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1148
                case __MASKSMALLINT(SLONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1149
                case __MASKSMALLINT(FLOATARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1150
                    if ((unsigned)indx < (unsigned)nIndex) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1151
                        RETURN ( __MKSMALLINT( pFirst[indx]) );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1152
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1153
                    break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1154
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1155
                case __MASKSMALLINT(LONGLONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1156
                case __MASKSMALLINT(SLONGLONGARRAY):
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  1157
#ifdef __NEED_LONGLONG_ALIGN
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1158
                    if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1159
                        int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1160
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1161
                        pFirst += delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1162
                        nIndex -= delta;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1163
                    }
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  1164
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1165
                    if ((unsigned)indx < (unsigned)nIndex) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1166
                        RETURN ( __MKSMALLINT( pFirst[indx]) );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1167
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1168
                    break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1169
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1170
        }
2574
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1171
    }
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1172
%}.
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1173
    "/ index not integer or index out of range
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1174
    "/ or non-byte indexable receiver
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1175
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1176
    ^ self primitiveFailed
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1177
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1178
    "
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1179
     Point new byteAt:1
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1180
     (ByteArray with:1 with:2) byteAt:2
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1181
     (WordArray with:1) byteAt:1       
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1182
     (FloatArray with:1.0) byteAt:2 
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1183
     'hello' byteAt:1               
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1184
    "
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1185
!
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1186
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1187
byteAt:index put:byteValue
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1188
    "set the byte at index. 
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1189
     This is only allowed for non-pointer indexed objects
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1190
     (i.e. byteArrays, wordArrays, floatArrays etc.).
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1191
     The receivers indexed instvars are treated as an uninterpreted
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1192
     collection of bytes.
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1193
     Only useful with binary storage."
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1194
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1195
%{  /* NOCONTEXT */
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1196
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1197
    REGISTER int indx;
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1198
    int val, nIndex;
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1199
    REGISTER OBJ slf;
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1200
    REGISTER OBJ cls;
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1201
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1202
    if (__bothSmallInteger(index, byteValue)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1203
        val = __intVal(byteValue);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1204
        if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1205
            slf = self;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1206
            if (__isNonNilObject(slf)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1207
                cls = __qClass(slf);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1208
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1209
                indx = __intVal(index) - 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1210
                switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1211
                    case __MASKSMALLINT(BYTEARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1212
                    case __MASKSMALLINT(WORDARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1213
                    case __MASKSMALLINT(LONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1214
                    case __MASKSMALLINT(SWORDARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1215
                    case __MASKSMALLINT(SLONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1216
                    case __MASKSMALLINT(LONGLONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1217
                    case __MASKSMALLINT(SLONGLONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1218
                    case __MASKSMALLINT(FLOATARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1219
                    case __MASKSMALLINT(DOUBLEARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1220
                        indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1221
                        nIndex = __byteArraySize(slf);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1222
                        if ((unsigned)indx < (unsigned)nIndex) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1223
                            __ByteArrayInstPtr(slf)->ba_element[indx] = val;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1224
                            RETURN ( byteValue );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1225
                        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1226
                        break;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1227
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1228
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1229
        }
2574
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1230
    }
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1231
%}.
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1232
    "/ index not integer or index out of range
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1233
    "/ or non-byte indexable receiver
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1234
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1235
    ^ self primitiveFailed
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1236
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1237
    "
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1238
     (ByteArray with:1 with:2) byteAt:2 put:3; yourself
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1239
     'hello' copy byteAt:1 put:105; yourself              
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1240
    "
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1241
!
3df87ac8838c added #byteAt: / #byteAt:put: to access any non-pointer objects
Claus Gittinger <cg@exept.de>
parents: 2511
diff changeset
  1242
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1243
instVarAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1244
    "return a non-indexed instance variable;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1245
     peeking into an object this way is not very object oriented 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1246
     - use with care (needed for copy, inspector etc.)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1247
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1248
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1249
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1250
    OBJ myClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1251
    int idx, ninstvars;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1252
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  1253
    if (__isSmallInteger(index)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1254
        myClass = __Class(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1255
        idx = __intVal(index) - 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1256
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1257
         * do not allow returning of non-object fields.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1258
         * if subclass did not make privisions for that,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1259
         * we wont do so here ...
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1260
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1261
        if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1262
            if (idx == 0) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1263
                RETURN ( nil )
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1264
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1265
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1266
        ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1267
        if ((idx >= 0) && (idx < ninstvars)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1268
            RETURN ( __InstPtr(self)->i_instvars[idx] );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1269
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1270
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1271
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1272
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1273
    index isInteger ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1274
        ^ self indexNotInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1275
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1276
    ^ self subscriptBoundsError:index
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1277
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1278
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1279
instVarAt:index put:value
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1280
    "change a non-indexed instance variable;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1281
     peeking into an object this way is not very object oriented 
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1282
     - use with care (needed for copy, inspector etc.)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1283
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1284
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1285
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1286
    OBJ myClass;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1287
    int idx, ninstvars;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1288
253
30daee717a53 *** empty log message ***
claus
parents: 228
diff changeset
  1289
    if (__isSmallInteger(index)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1290
        myClass = __Class(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1291
        idx = __intVal(index) - 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1292
        ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1293
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1294
         * do not allow setting of non-object fields.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1295
         * if subclass did not make privisions for that,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1296
         * we wont do so here ...
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1297
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1298
        if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1299
            if (idx == 0) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1300
                RETURN ( nil )
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1301
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1302
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1303
        if ((idx >= 0) && (idx < ninstvars)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1304
            __InstPtr(self)->i_instvars[idx] = value;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1305
            __STORE(self, value);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1306
            RETURN ( value );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1307
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1308
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1309
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1310
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1311
    index isInteger ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1312
        ^ self indexNotInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1313
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1314
    ^ self subscriptBoundsError:index
359
claus
parents: 357
diff changeset
  1315
!
claus
parents: 357
diff changeset
  1316
claus
parents: 357
diff changeset
  1317
instVarNamed:name 
claus
parents: 357
diff changeset
  1318
    "return a non-indexed instance variables value by name;
claus
parents: 357
diff changeset
  1319
     peeking into an object this way is not very object oriented 
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1320
     - use with care if at all (provided for inspectors and memory usage monitor).
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1321
     Notice, this access is very slow (because the classes instVar-description has to be
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1322
     parsed ad runtime)"
359
claus
parents: 357
diff changeset
  1323
claus
parents: 357
diff changeset
  1324
    ^ self instVarAt:(self class instVarOffsetOf:name)
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1325
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1326
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1327
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1328
     |p|
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1329
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1330
     p := Point x:10 y:20.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1331
     p instVarNamed:'x'  
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1332
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1333
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1334
    "Modified: 19.4.1996 / 11:12:39 / cg"
359
claus
parents: 357
diff changeset
  1335
!
claus
parents: 357
diff changeset
  1336
1528
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1337
instVarNamed:name ifAbsent:exceptionBlock
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1338
    "return a non-indexed instance variables value by name,
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1339
     or the value of exceptionBlock, if there is no such instance variable.
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1340
     peeking into an object this way is not very object oriented 
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1341
     - use with care if at all (provided for inspectors and memory usage monitor).
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1342
     Notice, this access is very slow (because the classes instVar-description has to be
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1343
     parsed ad runtime)"
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1344
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1345
    |idx|
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1346
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1347
    idx := self class instVarOffsetOf:name.
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1348
    idx isNil ifTrue:[^ exceptionBlock value].
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1349
    ^ self instVarAt:idx
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1350
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1351
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1352
    "
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1353
     |p|
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1354
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1355
     p := Point x:10 y:20.
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1356
     p instVarNamed:'x'  
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1357
    "
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1358
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1359
    "Created: 6.7.1996 / 23:02:49 / cg"
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1360
    "Modified: 6.7.1996 / 23:03:41 / cg"
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1361
!
af168e6dadc9 added #instVarNamed:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 1515
diff changeset
  1362
359
claus
parents: 357
diff changeset
  1363
instVarNamed:name put:value
claus
parents: 357
diff changeset
  1364
    "set a non-indexed instance variable by name;
claus
parents: 357
diff changeset
  1365
     peeking into an object this way is not very object oriented 
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1366
     - if at all, use with care (provided for protocol completeness).
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1367
     Notice, this access is very slow (because the classes instVar-description has to be
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1368
     parsed ad runtime)"
359
claus
parents: 357
diff changeset
  1369
claus
parents: 357
diff changeset
  1370
    ^ self instVarAt:(self class instVarOffsetOf:name) put:value
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1371
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1372
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1373
     |p|
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1374
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1375
     p := Point x:10 y:20.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1376
     p instVarNamed:'x' put:30.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1377
     p  
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1378
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1379
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  1380
    "Modified: 19.4.1996 / 11:12:49 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1381
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1382
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1383
!Object methodsFor:'attributes access'!
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1384
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1385
objectAttributeAt:key 
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1386
    "return the attribute for a given key or nil if not found"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1387
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1388
    | attrs |
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1389
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1390
    attrs := self objectAttributes.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1391
    (attrs notNil and:[attrs size > 0]) ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1392
        ^ attrs at:key ifAbsent:[]
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1393
    ].
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1394
    ^ nil
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1395
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1396
    "Created: / 22.1.1998 / 21:29:17 / av"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1397
    "Modified: / 3.2.1998 / 18:55:55 / cg"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1398
!
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1399
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1400
objectAttributeAt:key put:anObject
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1401
    "store the attribute anObject referenced by key into the receiver"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1402
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1403
    |wasBlocked|
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1404
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1405
    "/ must do this save from interrupts, since the attributes collection
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1406
    "/ is possibly accessed from multiple threads ...
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1407
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1408
    wasBlocked := OperatingSystem blockInterrupts.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1409
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1410
        | attrs |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1411
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1412
        attrs := self objectAttributes.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1413
        (attrs isNil or:[attrs size == 0]) ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1414
            attrs := WeakIdentityDictionary new.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1415
            attrs at:key put:anObject.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1416
            self objectAttributes:attrs.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1417
        ] ifFalse:[ 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1418
            attrs at:key put:anObject.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1419
        ].
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1420
    ] valueNowOrOnUnwindDo:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1421
        wasBlocked ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1422
            OperatingSystem unblockInterrupts
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1423
        ]
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1424
    ]
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1425
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1426
    "Attaching additional attributes (slots) to an arbitrary object:
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1427
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1428
     |p|
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1429
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1430
     p := Point new.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1431
     p objectAttributeAt:#color put:#green.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1432
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1433
     p objectAttributeAt:#color
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1434
    "
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1435
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1436
    "Created: / 22.1.1998 / 21:29:25 / av"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1437
    "Modified: / 3.2.1998 / 18:57:58 / cg"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1438
!
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1439
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1440
objectAttributes
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1441
    "return a Collection of attributes - nil if there is none.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1442
     The default implementation here uses a global WeakDictionary to store
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1443
     attributes
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1444
     This may be too slow for high frequency slot access,
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1445
     therefore, some classes may redefine this for better performance.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1446
     Notice the mentioning of a WeakDictionary - read the classes documentation."
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1447
5270
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1448
    ^ ObjectAttributes at:self ifAbsent:[nil]
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1449
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1450
    "Created: / 22.1.1998 / 21:29:30 / av"
5270
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1451
    "Modified: / 18.2.2000 / 11:34:16 / cg"
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1452
!
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1453
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1454
objectAttributes:aCollection
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1455
    "set the collection of attributes.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1456
     The default implementation here uses a global Dictionary to store
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1457
     attributes which may be too slow for high frequency change&update.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1458
     Therefore, some classes may redefine this for better performance."
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1459
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1460
    "/ must do this save from interrupts, since the attributes collection
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1461
    "/ is possibly accessed from multiple threads.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1462
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1463
    (OperatingSystem blockInterrupts) ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1464
        "/ the common case - already blocked
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1465
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1466
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
5424
3ffaef20cfd0 removeKey:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 5421
diff changeset
  1467
            ObjectAttributes removeKey:self ifAbsent:nil
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1468
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1469
            ObjectAttributes at:self put:aCollection
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1470
        ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1471
        ^ self
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1472
    ].
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1473
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1474
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1475
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
5424
3ffaef20cfd0 removeKey:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 5421
diff changeset
  1476
            ObjectAttributes removeKey:self ifAbsent:nil
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1477
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1478
            ObjectAttributes at:self put:aCollection
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1479
        ].
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1480
    ] valueNowOrOnUnwindDo:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1481
        OperatingSystem unblockInterrupts
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1482
    ]
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1483
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1484
    "Created: / 22.1.1998 / 21:29:35 / av"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1485
    "Modified: / 3.2.1998 / 18:58:10 / cg"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1486
!
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1487
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1488
removeObjectAttribute:anObject
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1489
    "make the argument, anObject be no attribute of the receiver"
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1490
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1491
    |wasBlocked|
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1492
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1493
    "/ must do this save from interrupts, since the attributes collection
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1494
    "/ is possibly accessed from multiple threads.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1495
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1496
    wasBlocked := OperatingSystem blockInterrupts.
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1497
    [
5270
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1498
        |attrs n a|
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1499
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1500
        attrs := self objectAttributes.
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1501
        attrs size == 0 ifTrue:[
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1502
            self objectAttributes:nil
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1503
        ] ifFalse:[
5424
3ffaef20cfd0 removeKey:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 5421
diff changeset
  1504
            attrs removeKey:anObject ifAbsent:nil.
5270
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1505
            attrs size == 0 ifTrue:[
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1506
                self objectAttributes:nil
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1507
            ]
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1508
        ]
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1509
    ] valueNowOrOnUnwindDo:[
5270
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1510
        wasBlocked ifFalse:[
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1511
            OperatingSystem unblockInterrupts
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1512
        ]
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1513
    ]
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1514
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1515
    "Created: / 22.1.1998 / 21:29:39 / av"
5270
01a597622eaf fixed #removeAttribute
Claus Gittinger <cg@exept.de>
parents: 5252
diff changeset
  1516
    "Modified: / 18.2.2000 / 11:32:19 / cg"
3268
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1517
! !
0974cb253cad incorporated AV's objectAttributs
Claus Gittinger <cg@exept.de>
parents: 3259
diff changeset
  1518
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1519
!Object methodsFor:'binary storage'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1520
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1521
hasSpecialBinaryRepresentation
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1522
    "return true, if the receiver has a special binary representation;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1523
     default here is false, but can be redefined in class which provide
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1524
     their own storeBinary/readBinary methods.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1525
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1526
     Normal user classes should not use this, it is meant as a hook for
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1527
     special classes such as True, False, UndefinedObject or SmallInteger.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1528
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1529
     If your instances should be stored in a special way, see
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1530
     #representBinaryOn: and #readBinaryContentsFromdata:manager:."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1531
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1532
    ^ false
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1533
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1534
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1535
readBinaryContentsFrom:stream manager:manager
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1536
    "reconstruct the receivers instance variables by reading a binary
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1537
     binary representation from stream. 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1538
     This is a general implementation, walking over instances 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1539
     and loading each recursively using manager.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1540
     Redefined by some classes to read a more compact representations
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1541
     (see String, SmallInteger etc).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1542
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1543
     Notice, that the object is already recreated as an empty corps
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1544
     with instance variables all nil and bit-instances (bytes, words etc.) 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1545
     already read and restored.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1546
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1547
     Also notice: this method is not called for if a private representation
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1548
     has been stored (see representBinaryOn:). 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1549
     In that case, #readBinaryContentsFromData:manager: is called, which
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1550
     has to be reimplemented in the objects class."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1551
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1552
    |size "{ Class: SmallInteger }"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1553
     instvarArray|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1554
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1555
    stream next == 1 ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1556
        "/
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1557
        "/ special representation ...
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1558
        "/
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1559
        instvarArray := Array new:(size := stream nextNumber:3).
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1560
        1 to:size do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1561
            instvarArray basicAt:i put:(manager nextObject)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1562
        ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1563
        self readBinaryContentsFromData:instvarArray manager:manager.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1564
        ^ self
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1565
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1566
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1567
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1568
    "/ standard representation
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1569
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1570
    size := self basicSize.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1571
    size ~~ 0 ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1572
        self class isPointers ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1573
            1 to:size do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1574
                self basicAt:i put:(manager nextObject)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1575
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1576
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1577
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1578
    size := self class instSize.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1579
    1 to:size do:[:i |
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1580
        self instVarAt:i put:(manager nextObject)
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1581
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1582
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1583
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1584
readBinaryContentsFromData:instvarArray manager:manager
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1585
    "reconstruct the receivers instance variables by filling instance
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1586
     variables with values from instvarArray. This array contains the instvars
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1587
     as specified in #representBinaryOn: when the object was stored.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1588
     It is the receivers responsibility to set its instance variables in the
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1589
     same order from that array."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1590
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1591
    ^ self subclassResponsibility
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1592
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1593
    "typical implementation (see also comment in #representBinaryOn:)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1594
     (for an object with foo, bar and baz as instance variables,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1595
      which did not store baz and wants baz to be reinitialized to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1596
      some constant string)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1597
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1598
        foo := instvarArray at:1.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1599
        bar := instvarArray at:2.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1600
        baz := 'aConstant'.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1601
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1602
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1603
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1604
representBinaryOn:manager
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1605
    "this method is called by the storage manager to ask objects
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1606
     if they wish to provide their own binary representation.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1607
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1608
     If they want to do so, they should return an array containing all
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1609
     instance variables (named & indexed pointer) to be stored. 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1610
     If not redefined, this method returns nil which means that all 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1611
     instance variables are to be stored.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1612
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1613
     It should be redefined in objects which do not want all instance variables
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1614
     to be stored (for example: objects which keep references to a view etc.).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1615
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1616
     If this is redefined returning non-nil, the corresponding class needs
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1617
     a redefined instance method named #readBinaryContentsFromData:manager:
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1618
     which has to fill the receivers named (and optionally indexed pointer)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1619
     instance variables with corresponding values from a data array."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1620
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1621
    ^ nil
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1622
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1623
    "typical implementation:  
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1624
     (see also comment in #readBinaryContentsFromData:manager:)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1625
     for an object with foo, bar and baz as instance variables,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1626
     which does not want to store baz:
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1627
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1628
     representBinaryOn:manager
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1629
        |data|
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1630
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1631
        data := Array new:2.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1632
        data at:1 put:foo.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1633
        data at:2 put:bar.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1634
        ^ data
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1635
    "
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1636
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1637
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1638
storeBinaryDefinitionBodyOn:stream manager:manager
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1639
    "append a binary representation of the receivers body onto stream.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1640
     This is a general implementation walking over instances storing
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1641
     each recursively as an ID using manager.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1642
     Can be redefined in subclasses."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1643
3078
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1644
    |basicSize    "{ Class: SmallInteger }"
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1645
     instSize     "{ Class: SmallInteger }"
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1646
     specialSize  "{ Class: SmallInteger }"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1647
     myClass specialRep pointers|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1648
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1649
    myClass := self class.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1650
    instSize := myClass instSize.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1651
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1652
    (pointers := myClass isPointers) ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1653
        "/
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1654
        "/ inst size not needed - if you uncomment the line below,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1655
        "/ also uncomment the corresponding line in
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1656
        "/ Object>>binaryDefinitionFrom:manager:
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1657
        "/
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1658
        "/ stream nextPut:instSize. "mhmh this limits us to 255 named instvars"
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1659
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1660
        myClass isVariable ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1661
            stream nextNumber:3 put:(basicSize := self basicSize)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1662
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1663
            basicSize := 0
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1664
        ].
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1665
    ] ifFalse: [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1666
        stream nextNumber:4 put:(basicSize := self basicSize).
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1667
        myClass isBytes ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1668
            1 to:basicSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1669
                stream nextPut:(self basicAt:i)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1670
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1671
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1672
            myClass isWords ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1673
                1 to:basicSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1674
                    stream nextNumber:2 put:(self basicAt: i)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1675
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1676
            ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1677
                myClass isLongs ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1678
                    1 to:basicSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1679
                        stream nextNumber:4 put:(self basicAt: i)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1680
                    ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1681
                ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1682
                    myClass isFloats ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1683
                        "could do it in one big write on machines which use IEEE floats ..."
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1684
                        1 to:basicSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1685
                            Float storeBinaryIEEESingle:(self basicAt:i) on:stream
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1686
                        ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1687
                    ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1688
                        myClass isDoubles ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1689
                            "could do it in one big write on machines which use IEEE doubles ..."
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1690
                            1 to:basicSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1691
                                Float storeBinaryIEEEDouble:(self basicAt:i) on:stream
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1692
                            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1693
                        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1694
                            "/ should never be reached ...
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1695
                            1 to:basicSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1696
                                manager putIdOf:(self basicAt:i) on:stream
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1697
                            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1698
                        ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1699
                    ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1700
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1701
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1702
        ].
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1703
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1704
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1705
    (pointers or:[instSize ~~ 0]) ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1706
        specialRep := self representBinaryOn:manager.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1707
        specialRep notNil ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1708
            specialSize := specialRep basicSize.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1709
            stream nextPut:1.     "/ means: private representation follows
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1710
            stream nextNumber:3 put:specialSize.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1711
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1712
            1 to:specialSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1713
                manager putIdOf:(specialRep at:i) on:stream
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1714
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1715
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1716
            stream nextPut:0.     "/ means: normal representation follows
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1717
                                  "/ index pointers followed by named instanceVars
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1718
            pointers ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1719
                basicSize ~~ 0 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1720
                    1 to:basicSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1721
                        manager putIdOf:(self basicAt:i) on:stream
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1722
                    ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1723
                ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1724
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1725
            instSize ~~ 0 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1726
                1 to:instSize do:[:i |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1727
                    manager putIdOf:(self instVarAt:i) on:stream
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1728
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1729
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1730
        ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1731
    ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1732
3078
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1733
    "Modified: / 2.11.1997 / 14:43:29 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1734
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1735
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1736
storeBinaryDefinitionOn:stream manager:manager
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1737
    "append a binary representation of the receiver onto stream.
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1231
diff changeset
  1738
     This is an internal interface for binary storage mechanism.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1739
     This method first stores the class, then the body, which is done
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1740
     in a separate method to allow redefinition of the bodies format.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1741
     Can be redefined in subclasses to write more compact representations
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1742
     (see String, SmallInteger etc)."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1743
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1744
    manager putIdOfClass:(self class) on:stream.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1745
    self storeBinaryDefinitionBodyOn:stream manager:manager
1260
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1231
diff changeset
  1746
2a8ba44e8957 commentary
Claus Gittinger <cg@exept.de>
parents: 1231
diff changeset
  1747
    "Modified: 23.4.1996 / 09:31:12 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1748
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1749
3078
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1750
storeBinaryOn:aStreamOrFilename
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1751
    "Writes a description of the receiver onto aStreamOrFilename, in a way that allows
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1752
     the object's structure to be reconstructed from the stream's contents"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1753
3078
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1754
    BinaryOutputManager store:self on:aStreamOrFilename
899
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1755
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1756
    "
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1757
     |a s1 s2|
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1758
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1759
     s1 := 'hello'.
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1760
     s2 := 'world'.
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1761
     a := Array new:5.
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1762
     a at:1 put:s1.
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1763
     a at:2 put:s2.
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1764
     a at:3 put:s1.
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1765
     a at:4 put:s2.
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1766
     a storeBinaryOn:'test.boss'
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1767
    "
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1768
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1769
    "
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1770
     (BinaryObjectStorage onOld:'test.boss' asFilename readStream)
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1771
        next
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1772
            inspect
899
ddcdb74e52de commentary
Claus Gittinger <cg@exept.de>
parents: 891
diff changeset
  1773
    "
3078
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1774
e48f06979043 binary storage tuning
Claus Gittinger <cg@exept.de>
parents: 3066
diff changeset
  1775
    "Modified: / 1.11.1997 / 21:16:24 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1776
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1777
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1778
storeBinaryOn:stream manager:manager
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1779
    "append a binary representation of the receiver onto stream."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1780
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1781
    manager putIdOf:self on:stream
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1782
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1783
1826
aa574220fff4 category rename
Claus Gittinger <cg@exept.de>
parents: 1820
diff changeset
  1784
!Object methodsFor:'change & update'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1785
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1786
broadcast:aSelectorSymbol
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1787
    "send a message with selector aSelectorSymbol to all my dependents"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1788
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1789
    self dependentsDo:[:dependent | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1790
        dependent perform:aSelectorSymbol
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1791
    ]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1792
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1793
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1794
broadcast:aSelectorSymbol with:anArgument
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1795
    "send a message with selector aSelectorSymbol with an additional
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1796
     argument anArgument to all my dependents."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1797
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1798
    self dependentsDo:[:dependent | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1799
        dependent perform:aSelectorSymbol with:anArgument
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1800
    ]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1801
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1802
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1803
changeRequest
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1804
    "the receiver wants to change - check if all dependents
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1805
     grant the request, and return true if so"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1806
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1807
    self dependentsDo:[:dependent | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1808
        dependent updateRequest ifFalse:[^ false].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1809
    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1810
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1811
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1812
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1813
changeRequest:aParameter
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1814
    "the receiver wants to change - check if all dependents
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1815
     grant the request, and return true if so"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1816
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1817
    self dependentsDo:[:dependent | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1818
        (dependent updateRequest:aParameter) ifFalse:[^ false].
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1819
    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1820
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1821
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1822
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1823
changeRequest:aParameter from:anObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1824
    "the receiver wants to change - check if all dependents
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1825
     except anObject grant the request, and return true if so.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1826
     The argument anObject is typically going to be the one who is
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1827
     about to send the change request."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1828
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1829
    self dependentsDo:[:dependent | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1830
        dependent == anObject ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1831
            (dependent updateRequest:aParameter) ifFalse:[^ false].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1832
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1833
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1834
    ^ true
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1835
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1836
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1837
changeRequestFrom:anObject
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1838
    "the receiver wants to change - check if all dependents
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1839
     except anObject grant the request, and return true if so.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1840
     The argument anObject is typically going to be the one who is
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1841
     about to send the change request."
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1842
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1843
    self dependentsDo:[:dependent | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1844
        dependent == anObject ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1845
            (dependent updateRequest) ifFalse:[^ false].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1846
        ]
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1847
    ].
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1848
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1849
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1850
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1851
changed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1852
    "notify all dependents that the receiver has changed.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1853
     Each dependent gets a '#update:'-message with the original
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1854
     receiver as argument."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1855
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1856
    self changed:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1857
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1858
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1859
changed:aParameter
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1860
    "notify all dependents that the receiver has changed somehow.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1861
     Each dependent gets a '#update:'-message with aParameter
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1862
     as argument."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1863
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1864
    self changed:aParameter with:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1865
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1866
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1867
changed:aParameter with:anArgument
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1868
    "notify all dependents that the receiver has changed somehow.
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1869
     Each dependent gets a  '#update:with:from:'-message, with aParameter
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1870
     and anArgument as arguments."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1871
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1872
    self dependentsDo:[:dependent | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1873
        dependent update:aParameter with:anArgument from:self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1874
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1875
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1876
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1877
update:aParameter
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1878
    "the message is sent to a dependent, when one of the objects
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1879
     on whom the receiver depends, has changed. The argument aParameter
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1880
     is either the changed object or the argument to the #changed: message.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1881
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  1882
     Default behavior here is to do nothing"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1883
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1884
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1885
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1886
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1887
update:aParameter with:anArgument
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1888
    "dependent is notified of some change -
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1889
     Default is to try update:"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1890
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1891
    ^ self update:aParameter
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1892
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1893
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1894
update:aParameter with:anArgument from:sender
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1895
    "dependent is notified of some change -
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1896
     Default is to try update:with:"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1897
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1898
    ^ self update:aParameter with:anArgument
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1899
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1900
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1901
updateRequest
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1902
    "return true, if an update request is granted.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1903
     Default here is to grant updates - may be used
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1904
     to lock updates if someone is making other changes
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1905
     from within an update. Or if someone has locked its
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1906
     state and does not want others to change things.
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1907
     However, these dependents must all honor the
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1908
     changeRequest - ifTrue - change protocol. I.e. they
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1909
     must first ask all others via changeRequest, and only do the change
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1910
     it returns true. The others must decide in updateRequest and
40ca7cc6fb9c *** empty log message ***
claus
parents: 179
diff changeset
  1911
     return true if they think a change is ok."
159
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1912
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1913
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1914
!
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1915
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1916
updateRequest:aSymbol
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1917
    "return true, if an update request is granted.
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1918
     Default here a simple updateRequest"
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1919
514c749165c3 *** empty log message ***
claus
parents: 143
diff changeset
  1920
    ^ self updateRequest
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1921
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1922
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1923
!Object methodsFor:'cleanup'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1924
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1925
lowSpaceCleanup
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1926
    "ignored here - redefined in some classes to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1927
     cleanup in low-memory situations"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1928
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1929
    ^ self
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1930
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1931
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1932
!Object methodsFor:'comparing'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1933
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1934
= anObject
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  1935
    "return true, if the receiver and the arg have the same structure.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  1936
     Notice:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1937
        This method is partially open coded (inlined) by the compiler(s)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1938
        identical objects are always considered equal.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1939
        redefining it may not work as expected."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1940
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1941
    ^ self == anObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1942
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1943
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1944
== anObject
2505
3c9bf86f9e9a comment
Claus Gittinger <cg@exept.de>
parents: 2502
diff changeset
  1945
    "return true, if the receiver and the arg are the same object.
3c9bf86f9e9a comment
Claus Gittinger <cg@exept.de>
parents: 2502
diff changeset
  1946
     Never redefine this in any class.
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  1947
     Notice:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1948
        This method is open coded (inlined) by the compiler(s)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1949
        - redefining it may not work as expected."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1950
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1951
%{  /* NOCONTEXT */
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1952
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1953
    RETURN ( (self == anObject) ? true : false );
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1954
%}
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1955
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1956
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1957
hash
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1958
    "return an Integer useful as a hash key for the receiver.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1959
     This hash should return same values for objects with same
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1960
     contents (i.e. use this to hash on structure)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1961
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1962
    ^ self identityHash
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1963
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1964
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1965
identityHash
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1966
    "return an Integer useful as a hash key for the receiver.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1967
     This hash should return same values for the same object (i.e. use
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1968
     this to hash on identity of objects).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1969
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1970
     We cannot use the Objects address (as other smalltalks do) since
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1971
     no object-table exists and the hashval must not change when objects
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1972
     are moved by the collector. Therefore we assign each object a unique
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1973
     Id in the object header itself as its hashed upon.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1974
     (luckily we have 11 bits spare to do this - unluckily its only 11 bits).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1975
     Time will show, if 11 bits are enough; if not, another entry in the
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1976
     object header will be needed, adding 4 bytes to every object. Alternatively,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1977
     hashed-upon objects could add an instvar containing the hash value."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1978
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1979
%{  /* NOCONTEXT */
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1980
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1981
    REGISTER unsigned hash;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1982
    static unsigned nextHash = 0;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1983
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  1984
    if (__isNonNilObject(self)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1985
        hash = __GET_HASH(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1986
        if (hash == 0) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1987
            /* has no hash yet */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1988
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1989
            if (++nextHash > __MAX_HASH__) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1990
                nextHash = 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1991
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1992
            hash = nextHash;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1993
            __SET_HASH(self, hash);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1994
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1995
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1996
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1997
         * now, we got 11 bits for hashing;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1998
         * make it as large as possible; since most hashers use the returned
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  1999
         * key and take it modulo some prime number, this will allow for
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2000
         * better distribution (i.e. bigger empty spaces) in hashed collection.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2001
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2002
        hash = __MAKE_HASH__(hash);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2003
        RETURN ( __MKSMALLINT(hash) );
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2004
    }
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2005
%}.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2006
    ^ 0 "never reached, since redefined in UndefinedObject and SmallInteger"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2007
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2008
2479
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2009
identityHashForBinaryStore
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2010
    "hash which is usable if the object does not change its class
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2011
     and does not #become something else, while the hash is used.
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2012
     This is only used by the binary storage mechanism, during the
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2013
     object writing phase."
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2014
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2015
%{  /* NOCONTEXT */
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2016
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2017
    REGISTER unsigned hash, hash1, hash2, sz;
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2018
    OBJ o;
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2019
    static unsigned nextHash = 0;
2480
077b0a0f9248 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2479
diff changeset
  2020
    static unsigned nextClassHash = 0;
2479
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2021
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2022
    if (__isNonNilObject(self)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2023
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2024
         * my own identityHash
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2025
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2026
        hash1 = __GET_HASH(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2027
        if (hash1 == 0) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2028
            /* has no hash yet */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2029
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2030
            if (++nextHash > __MAX_HASH__) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2031
                nextHash = 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2032
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2033
            hash1 = nextHash;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2034
            __SET_HASH(self, hash1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2035
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2036
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2037
         * my classes identityHash
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2038
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2039
        o = __qClass(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2040
        hash2 = __GET_HASH(o);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2041
        if (hash2 == 0) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2042
            /* has no hash yet */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2043
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2044
            if (++nextClassHash > __MAX_HASH__) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2045
                nextClassHash = 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2046
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2047
            hash2 = nextClassHash;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2048
            __SET_HASH(o, hash2);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2049
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2050
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2051
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2052
         * some bits of my size
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2053
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2054
        sz = __qSize(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2055
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2056
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2057
         * now, we got 11 + 11 + 8 bits for hashing;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2058
         * make it as large as possible; since most hashers use the returned
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2059
         * key and take it modulo some prime number, this will allow for
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2060
         * better distribution (i.e. bigger empty spaces) in hashed collection.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2061
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2062
        hash = (hash1 << 11) | hash2;           /* 22 bits */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2063
        hash = (hash << 8) | (sz & 0xFC);       /* 30 bits */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2064
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2065
        while ((hash & 0x20000000) == 0) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2066
            hash <<= 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2067
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2068
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2069
        RETURN ( __MKSMALLINT(hash) );
2479
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2070
    }
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2071
%}.
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  2072
    "never reached, since UndefinedObject and SmallInteger are not hashed upon in binary storage"
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  2073
    ^ self identityHash
2479
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2074
!
6d9c516e04d8 added special hash for binaryStorage
Claus Gittinger <cg@exept.de>
parents: 2478
diff changeset
  2075
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2076
isNil
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  2077
    "return true, if the receiver is nil.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  2078
     Notice:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2079
        This method is open coded (inlined) by the compiler(s)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2080
        - redefining it may not work as expected."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2081
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2082
    ^ false
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2083
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2084
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2085
notNil
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  2086
    "return true, if the receiver is not nil.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  2087
     Notice:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2088
        This method is open coded (inlined) by the compiler(s)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2089
        - redefining it may not work as expected."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2090
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2091
    ^ true
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2092
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2093
3384
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2094
sameContentsAs:anObject
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2095
    "return true, if the receiver and the arg have the same contents
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2096
     in both the named instance vars and any indexed instVars."
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2097
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2098
    |myClass otherClass
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2099
     sz "{ Class: SmallInteger }" |
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2100
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2101
    myClass := self class.
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2102
    myClass isVariable ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2103
        sz := self basicSize.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2104
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2105
        "compare the indexed variables"
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2106
        1 to:sz do:[:i | 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2107
            (self basicAt:i) ~~ (anObject basicAt:i) ifTrue:[^ false].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2108
        ]
3384
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2109
    ].
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2110
3385
31a7cbc6cf32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3384
diff changeset
  2111
    "compare the instance variables"
3384
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2112
    sz := myClass instSize.
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2113
    1 to:sz do:[:i | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2114
        (self instVarAt:i) ~~ (anObject instVarAt:i) ifTrue:[^ false].
3384
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2115
    ].
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2116
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2117
    ^ true
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2118
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2119
    "
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2120
     #(1 2 3 4) sameContentsAsIn:#[1 2 3 4] asArray 
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2121
     (1@2) sameContentsAsIn:(1->2)
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2122
    "
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2123
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2124
    "Created: / 21.4.1998 / 15:56:40 / cg"
3385
31a7cbc6cf32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3384
diff changeset
  2125
    "Modified: / 21.4.1998 / 15:58:15 / cg"
3384
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2126
!
b0f2f2aca95f added #sameContentsAs: (helper for MessageTracer)
Claus Gittinger <cg@exept.de>
parents: 3380
diff changeset
  2127
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2128
~= anObject
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  2129
    "return true, if the receiver and the arg do not have the same structure.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  2130
     Notice:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2131
        This method is partially open coded (inlined) by the compiler(s)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2132
        identical objects are never considered unequal.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2133
        redefining it may not work as expected."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2134
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2135
    ^ (self = anObject) not
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2136
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2137
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2138
~~ anObject
2505
3c9bf86f9e9a comment
Claus Gittinger <cg@exept.de>
parents: 2502
diff changeset
  2139
    "return true, if the receiver and the arg are not the same object.
3c9bf86f9e9a comment
Claus Gittinger <cg@exept.de>
parents: 2502
diff changeset
  2140
     Never redefine this in any class.
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  2141
     Notice:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2142
        This method is open coded (inlined) by the compiler(s)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2143
        - redefining it may not work as expected."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2144
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2145
%{  /* NOCONTEXT */
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2146
    RETURN ( (self == anObject) ? false : true );
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2147
%}
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2148
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2149
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2150
!Object methodsFor:'converting'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2151
3007
8d3e37e159c0 category change
Claus Gittinger <cg@exept.de>
parents: 3005
diff changeset
  2152
-> anObject
8d3e37e159c0 category change
Claus Gittinger <cg@exept.de>
parents: 3005
diff changeset
  2153
    "return an association with the receiver as key and
8d3e37e159c0 category change
Claus Gittinger <cg@exept.de>
parents: 3005
diff changeset
  2154
     the argument as value"
8d3e37e159c0 category change
Claus Gittinger <cg@exept.de>
parents: 3005
diff changeset
  2155
8d3e37e159c0 category change
Claus Gittinger <cg@exept.de>
parents: 3005
diff changeset
  2156
    ^ Association key:self value:anObject
8d3e37e159c0 category change
Claus Gittinger <cg@exept.de>
parents: 3005
diff changeset
  2157
!
8d3e37e159c0 category change
Claus Gittinger <cg@exept.de>
parents: 3005
diff changeset
  2158
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2159
asValue
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2160
    "return a valueHolder for for the receiver"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2161
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2162
    ^ ValueHolder with:self
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2163
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2164
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2165
!Object methodsFor:'copying'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2166
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2167
cloneFrom:anObject 
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2168
    "Helper for copy:
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2169
     copy all instance variables from anObject into the receiver,
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2170
     which should be of the same class as the argument."
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2171
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2172
    self cloneFrom:anObject performing:#yourself
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2173
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2174
    "
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2175
     |x|
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2176
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2177
     x := Array new:3.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2178
     x cloneFrom:#(1 2 3).
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2179
    "
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2180
!
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2181
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2182
cloneFrom:anObject performing:aSymbol
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2183
    "Helper for copy:
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2184
     for each instance variables from anObject, send it aSymbol
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2185
     and store the result into the receiver,
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2186
     which should be of the same class as the argument."
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2187
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2188
    |myClass sz "{ Class: SmallInteger }" t |
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2189
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2190
    myClass := self class.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2191
    myClass isVariable ifTrue:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2192
        sz := self basicSize.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2193
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2194
        "copy the indexed variables"
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2195
        1 to:sz do:[:i | 
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2196
            t := anObject basicAt:i.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2197
            aSymbol ~~ #yourself ifTrue:[
4734
c33b5d43202a oops - shallowCopy
Claus Gittinger <cg@exept.de>
parents: 4732
diff changeset
  2198
                t := t perform:aSymbol.
c33b5d43202a oops - shallowCopy
Claus Gittinger <cg@exept.de>
parents: 4732
diff changeset
  2199
            ].
c33b5d43202a oops - shallowCopy
Claus Gittinger <cg@exept.de>
parents: 4732
diff changeset
  2200
            self basicAt:i put:t.
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2201
        ]
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2202
    ].
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2203
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2204
    "copy the instance variables"
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2205
    sz := myClass instSize.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2206
    1 to:sz do:[:i | 
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2207
        t := anObject instVarAt:i.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2208
        aSymbol ~~ #yourself ifTrue:[
4734
c33b5d43202a oops - shallowCopy
Claus Gittinger <cg@exept.de>
parents: 4732
diff changeset
  2209
            t := t perform:aSymbol
c33b5d43202a oops - shallowCopy
Claus Gittinger <cg@exept.de>
parents: 4732
diff changeset
  2210
        ].
c33b5d43202a oops - shallowCopy
Claus Gittinger <cg@exept.de>
parents: 4732
diff changeset
  2211
        self instVarAt:i put:t
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2212
    ].
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2213
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2214
    ^ self
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2215
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2216
!
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2217
4693
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2218
cloneInstanceVariablesFrom:aPrototype
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2219
    "Shallow copy variables from a prototype into myself.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2220
     This copies instVars by name - i.e. same-named variables are
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2221
     copied, others are not.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2222
     The variable slots are copied as available 
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2223
     (i.e. the min of both indexed sizes is used)."
4693
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2224
        
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2225
    |myInfo otherInfo|
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2226
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2227
    myInfo := self class instanceVariableOffsets.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2228
    otherInfo := aPrototype class instanceVariableOffsets.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2229
    myInfo keysAndValuesDo:[:name :index | |varIndexAssoc|
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2230
        varIndexAssoc := otherInfo at:name ifAbsent:[].
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2231
        varIndexAssoc notNil ifTrue:[
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2232
            self instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2233
        ]
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2234
    ].
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2235
    self isVariable ifTrue:[
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2236
        1 to:(self basicSize min:aPrototype basicSize) do:[:index |
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2237
            self basicAt:index put:(aPrototype basicAt:index)
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2238
        ].
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2239
    ].
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2240
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2241
    "
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2242
     Class withoutUpdatingChangesDo:[
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2243
         Point subclass:#Point3D
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2244
           instanceVariableNames:'z'
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2245
           classVariableNames:''
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2246
           poolDictionaries:''
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2247
           category:'testing'.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2248
         (Point3D new cloneInstanceVariablesFrom:1@2) inspect.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2249
     ]
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2250
    "
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2251
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2252
    "
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2253
     Class withoutUpdatingChangesDo:[
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2254
         Point variableSubclass:#Point3D
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2255
           instanceVariableNames:'z'
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2256
           classVariableNames:''
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2257
           poolDictionaries:''
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2258
           category:'testing'.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2259
         ((Point3D new:2) cloneInstanceVariablesFrom:#(1 2 3)) inspect.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2260
     ]
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2261
    "
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2262
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2263
    "
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2264
     |someObject|
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2265
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2266
     Class withoutUpdatingChangesDo:[
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2267
         Object subclass:#TestClass1 
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2268
           instanceVariableNames:'foo bar'
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2269
           classVariableNames:''
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2270
           poolDictionaries:''
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2271
           category:'testing'.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2272
         someObject := TestClass1 new.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2273
         someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2274
         Object subclass:#TestClass2 
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2275
           instanceVariableNames:'bar foo'
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2276
           classVariableNames:''
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2277
           poolDictionaries:''
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2278
           category:'testing'.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2279
         (TestClass2 new cloneInstanceVariablesFrom:someObject) inspect.
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2280
     ]
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2281
    "
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2282
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2283
    "
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2284
     |top b b1|
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2285
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2286
     top := StandardSystemView new.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2287
     top extent:100@100.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2288
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2289
     b := Button in:top.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2290
     b label:'hello'.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2291
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2292
     b1 := ArrowButton new cloneInstanceVariablesFrom:b.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2293
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2294
     top open.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2295
     b1 inspect
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2296
    "
4693
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2297
!
2792b6043133 New: #cloneInstanceVariablesFrom:
Stefan Vogel <sv@exept.de>
parents: 4683
diff changeset
  2298
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2299
copy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2300
    "return a copy of the receiver - defaults to shallowcopy here.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2301
     Notice, that copy does not copy dependents."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2302
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2303
    ^ self shallowCopy postCopy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2304
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2305
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2306
deepCopy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2307
    "return a copy of the object with all subobjects also copied.
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2308
     This method DOES handle cycles/self-refs and preserves object identity; 
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2309
     however the receivers class is not copied (to avoid the 'total' copy).
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2310
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2311
     This deepCopy is a bit slower than the old (unsecure) one, since it
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2312
     keeps track of already copied objects. If you are sure, that your
1129
2734bcd503fe Fix typo in comment.
Stefan Vogel <sv@exept.de>
parents: 1119
diff changeset
  2313
     copied object does not include duplicates (or you do not care) and
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2314
     no cycles are involved, you can use the old simpleDeepCopy, 
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2315
     which avoids this overhead (but may run into trouble).
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2316
     Notice, that deepCopy does not copy dependents."
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2317
4799
595b19e24edb re-added postDeepCopyFrom:
Claus Gittinger <cg@exept.de>
parents: 4734
diff changeset
  2318
    ^ (self deepCopyUsing:(IdentityDictionary new)) postDeepCopyFrom:self
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2319
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2320
    "an example which is not handled by the old deepCopy:
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2321
    
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2322
     |a|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2323
     a := Array new:3.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2324
     a at:3 put:a.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2325
     a deepCopy inspect
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2326
    "
1129
2734bcd503fe Fix typo in comment.
Stefan Vogel <sv@exept.de>
parents: 1119
diff changeset
  2327
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2328
    "
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2329
     |a|
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2330
     a := Color black onDevice:Screen current.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2331
     a deepCopy inspect
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2332
    "
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2333
1129
2734bcd503fe Fix typo in comment.
Stefan Vogel <sv@exept.de>
parents: 1119
diff changeset
  2334
    "Modified: 27.3.1996 / 16:31:20 / stefan"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2335
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2336
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2337
deepCopyError
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2338
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2339
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2340
    "raise a signal, that deepCopy is not allowed for this object"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2341
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2342
    ^ DeepCopyErrorSignal raise
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2343
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2344
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2345
deepCopyUsing:aDictionary
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2346
    "a helper for deepCopy; return a copy of the object with 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2347
     all subobjects also copied. If the to-be-copied object is in the dictionary, 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2348
     use the value found there. The class of the receiver is not copied.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2349
     This method DOES handle cycles/self references."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2350
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2351
    |myClass aCopy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2352
     sz "{ Class: SmallInteger }" 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2353
     iOrig iCopy|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2354
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2355
    myClass := self class.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2356
    myClass isVariable ifTrue:[
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2357
        sz := self basicSize.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2358
        aCopy := myClass basicNew:sz.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2359
    ] ifFalse:[
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2360
        sz := 0.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2361
        aCopy := myClass basicNew
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2362
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2363
    aCopy setHashFrom:self.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2364
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2365
    aDictionary at:self put:aCopy.
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2366
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2367
    "
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2368
     copy indexed instvars - if any
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2369
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2370
    sz ~~ 0 ifTrue:[
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2371
        myClass isBits ifTrue:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2372
            "block-copy indexed instvars"
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2373
            aCopy replaceFrom:1 to:sz with:self startingAt:1
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2374
        ] ifFalse:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2375
            "individual deep copy the indexed variables"
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2376
            1 to:sz do:[:i | 
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2377
                iOrig := self basicAt:i.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2378
                iOrig notNil ifTrue:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2379
                    (aDictionary includesKey:iOrig) ifTrue:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2380
                        iCopy := aDictionary at:iOrig
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2381
                    ] ifFalse:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2382
                        iCopy := (iOrig deepCopyUsing:aDictionary) postDeepCopy
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2383
                    ].
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2384
                    aCopy basicAt:i put:iCopy
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2385
                ]
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2386
            ]
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2387
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2388
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2389
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2390
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2391
     copy the instance variables
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2392
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2393
    sz := myClass instSize.
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2394
    1 to:sz do:[:i |
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2395
        (self skipInstvarIndexInDeepCopy:i) ifFalse:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2396
            iOrig := self instVarAt:i.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2397
            iOrig notNil ifTrue:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2398
                (aDictionary includesKey:iOrig) ifTrue:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2399
                    iCopy := aDictionary at:iOrig
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2400
                ] ifFalse:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2401
                    iCopy := (iOrig deepCopyUsing:aDictionary) postDeepCopy
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2402
                ].
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2403
                aCopy instVarAt:i put:iCopy
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2404
            ]
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2405
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2406
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2407
    ^ aCopy
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2408
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2409
    "
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2410
     |a b c copyOfC|
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2411
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2412
     a := Array with:'hello' with:'world' with:nil.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2413
     b := 99 @ 999.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2414
     a at:3 put:b.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2415
     c := Array with:a with:b with:a.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2416
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2417
     Transcript showCR: (c at:1) == (c at:3).
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2418
     copyOfC := c deepCopy.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2419
     Transcript showCR: (copyOfC at:1) == (copyOfC at:3)
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2420
    "
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2421
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2422
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2423
postCopy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2424
    "this is for compatibility with ST-80 code, which uses postCopy for
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2425
     cleanup after copying, while ST/X passes the original in postCopyFrom:
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2426
     (see there)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2427
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2428
    ^ self
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2429
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2430
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2431
postDeepCopy
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2432
    "allows for cleanup after deep copying"
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2433
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2434
    ^ self postCopy
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2435
!
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2436
4799
595b19e24edb re-added postDeepCopyFrom:
Claus Gittinger <cg@exept.de>
parents: 4734
diff changeset
  2437
postDeepCopyFrom:aSource
595b19e24edb re-added postDeepCopyFrom:
Claus Gittinger <cg@exept.de>
parents: 4734
diff changeset
  2438
    "allows for cleanup after deep copying"
595b19e24edb re-added postDeepCopyFrom:
Claus Gittinger <cg@exept.de>
parents: 4734
diff changeset
  2439
595b19e24edb re-added postDeepCopyFrom:
Claus Gittinger <cg@exept.de>
parents: 4734
diff changeset
  2440
    ^ self postDeepCopy
595b19e24edb re-added postDeepCopyFrom:
Claus Gittinger <cg@exept.de>
parents: 4734
diff changeset
  2441
!
595b19e24edb re-added postDeepCopyFrom:
Claus Gittinger <cg@exept.de>
parents: 4734
diff changeset
  2442
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2443
setHashFrom:anObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2444
    "set my identity-hash key to be the same as anObjects hash key. 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2445
     This is an ST/X speciality, which is NOT available in other (especially OT based) 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2446
     Smalltalks, and may not be available in future ST/X versions.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2447
     DO NEVER use this for normal application code."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2448
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2449
%{  /* NOCONTEXT */
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2450
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2451
    REGISTER unsigned h;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2452
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2453
    if (__isNonNilObject(self) && __isNonNilObject(anObject)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2454
        h = __GET_HASH(anObject);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2455
        __SET_HASH(self, h);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2456
        RETURN (self);
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2457
    }
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2458
%}.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2459
    self primitiveFailed    "neither receiver not arg may be nil or SmallInteger"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2460
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2461
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2462
shallowCopy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2463
    "return a copy of the object with shared subobjects (a shallow copy)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2464
     i.e. the copy shares referenced instvars with its original."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2465
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2466
%{  /* NOCONTEXT */
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2467
    int ninsts, spc;
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2468
    int sz;
3066
eb7489e8275a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3063
diff changeset
  2469
    OBJ theCopy;
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2470
    OBJ cls;
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2471
    int flags;
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2472
2651
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2473
    cls = __qClass(self);
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2474
    flags = __intVal(__ClassInstPtr(cls)->c_flags);
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2475
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2476
    /*
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2477
     * bail out for special objects ..
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2478
     */
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2479
    if (((flags & ~ARRAYMASK) == 0)
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2480
     && ((flags & ARRAYMASK) != WKPOINTERARRAY)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2481
        sz = __qSize(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2482
        __PROTECT__(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2483
        __qNew(theCopy, sz);    /* OBJECT ALLOCATION */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2484
        __UNPROTECT__(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2485
        if (theCopy) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2486
            cls = __qClass(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2487
            spc = __qSpace(theCopy);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2488
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2489
            theCopy->o_class = cls; __STORE_SPC(theCopy, cls, spc);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2490
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2491
            sz = sz - OHDR_SIZE;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2492
            if (sz) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2493
                char *src, *dst;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2494
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2495
                src = (char *)(__InstPtr(self)->i_instvars);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2496
                dst = (char *)(__InstPtr(theCopy)->i_instvars);
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2497
#ifdef bcopy4
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2498
                {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2499
                    /* care for odd-number of longs */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2500
                    int nW = sz >> 2;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2501
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2502
                    if (sz & 3) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2503
                        nW++;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2504
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2505
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2506
                    bcopy4(src, dst, nW);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2507
                }
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2508
#else
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2509
                bcopy(src, dst, sz);
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2510
#endif
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2511
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2512
                flags &= ARRAYMASK;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2513
                if (flags == POINTERARRAY) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2514
                    ninsts = __BYTES2OBJS__(sz);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2515
                } else {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2516
                    ninsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2517
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2518
                if (ninsts) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2519
                    do {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2520
                        OBJ el;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2521
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2522
                        el = __InstPtr(theCopy)->i_instvars[ninsts-1];
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2523
                        __STORE_SPC(theCopy, el, spc);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2524
                    } while (--ninsts);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2525
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2526
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2527
            RETURN (theCopy);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2528
        }
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2529
    }
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  2530
%}.
2651
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2531
    "/ fallBack for special objects & memoryAllocation failure case
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2532
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2533
    ^ self slowShallowCopy
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2534
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2535
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2536
shallowCopyForFinalization
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2537
    "this is used to aquire a copy to be used for finalization -
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2538
     (the copy will get a dispose-notification; see the documentation in the Registry class)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2539
     This method can be redefined for more efficient copying - especially for large objects."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2540
4574
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  2541
    "/ going to be obsoleted by executor
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2542
    ^ self shallowCopy
4574
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  2543
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  2544
    "Modified: / 5.8.1999 / 14:07:16 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2545
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2546
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2547
simpleDeepCopy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2548
    "return a copy of the object with all subobjects also copied.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2549
     This method does NOT handle cycles - but is included to allow this 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2550
     slightly faster copy in situations where it is known that
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2551
     no recursive references occur (LargeIntegers for example).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2552
     NOTICE: you will run into trouble, when trying this with recursive
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2553
     objects (usually recursionInterrupt or memory-alert).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2554
     This method corresponds to the 'traditional' deepCopy found in
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2555
     the Blue book."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2556
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2557
    |myClass aCopy|
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2558
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2559
    (myClass := self class) isVariable ifTrue:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2560
        aCopy := myClass basicNew:(self basicSize).
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2561
    ] ifFalse:[
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2562
        aCopy := myClass basicNew
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2563
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2564
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2565
    "copy the instance variables"
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2566
    aCopy cloneFrom:self performing:#simpleDeepCopy.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2567
    ^ aCopy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2568
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2569
    "a bad example (but ST/X should survive ...)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2570
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2571
     |a|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2572
     a := Array new:3.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2573
     a at:3 put:a.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2574
     a simpleDeepCopy
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2575
    "
2651
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2576
!
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2577
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2578
skipInstvarIndexInDeepCopy:index
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2579
    "a helper for deepCopy; only indices for which this method returns
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2580
     false are copied in a deep copy.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2581
     The default is false here - which means that everything is copied.
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2582
     Can be redefined in subclasses for partial copies"
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2583
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2584
    ^ false
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2585
!
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2586
2651
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2587
slowShallowCopy
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2588
    "return a copy of the object with shared subobjects (a shallow copy)
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2589
     i.e. the copy shares referenced instvars with its original.
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2590
     This method is only invoked as a fallback from #shallowCopy."
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2591
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2592
    |myClass aCopy|
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2593
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2594
    (myClass := self class) isVariable ifTrue:[
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2595
        aCopy := myClass basicNew:(self basicSize).
2651
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2596
    ] ifFalse:[
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2597
        aCopy := myClass basicNew
2651
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2598
    ].
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2599
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2600
    "copy the instance variables"
4731
174be180114a deepCopy fixes and hooks
Claus Gittinger <cg@exept.de>
parents: 4693
diff changeset
  2601
    aCopy cloneFrom:self performing:#yourself.
2651
63087903a3e0 oops - shallowCopy was wrong
Claus Gittinger <cg@exept.de>
parents: 2647
diff changeset
  2602
    ^ aCopy
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2603
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2604
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2605
!Object methodsFor:'debugging'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2606
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2607
basicInspect
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2608
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2609
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2610
    "launch an inspector on the receiver.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2611
     this method should NOT be redefined in subclasses."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2612
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2613
    Inspector isNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2614
        "
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2615
         for systems without GUI
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2616
        "
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2617
        Transcript showCR:'no Inspector'
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2618
    ] ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2619
        Inspector openOn:self
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2620
    ]
1417
59e7d3c1df6d showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
  2621
59e7d3c1df6d showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
  2622
    "Modified: 18.5.1996 / 15:43:25 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2623
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2624
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2625
inspect
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2626
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2627
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2628
    "launch an inspector on the receiver.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2629
     this method (or better: inspectorClass) can be redefined in subclasses 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2630
     to start special inspectors."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2631
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2632
    |cls|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2633
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2634
    cls := self inspectorClass.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2635
    cls isNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2636
        ^ self basicInspect
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2637
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2638
    cls openOn:self
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2639
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2640
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2641
     Object new inspect
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2642
     (1 @ 2) inspect
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2643
     Smalltalk inspect
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2644
     #(1 2 3) asOrderedCollection inspect
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2645
     (Color red) inspect
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2646
     (Image fromFile:'bitmaps/garfield.gif') inspect
143
5ebe463ba109 got rid of globals;
claus
parents: 113
diff changeset
  2647
    "
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2648
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  2649
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2650
inspectorClass
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2651
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2652
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2653
    "return the class to use for inspect. 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2654
     Can (should) be redefined in classes for which a better inspector is available"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2655
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2656
    ^ Inspector
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2657
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2658
4600
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2659
mustBeBoolean
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2660
    "this message is sent by the VM, if a non-Boolean receiver is encountered
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2661
     in an if* or while* message.
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2662
     Caveat: for now, this is only sent by the interpreter;
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2663
     both the JIT and the stc compiler treat it as undefined."
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2664
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2665
    self error:'Non boolean receiver - proceed for truth' mayProceed:true.
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2666
    ^ true
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2667
!
050433a72954 preps for #mustBeBoolean.
Claus Gittinger <cg@exept.de>
parents: 4587
diff changeset
  2668
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2669
mustBeKindOf:aClass
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2670
    "for compatibility & debugging support: 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2671
     check if the receiver isKindOf:aClass and raise an error if not.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2672
     Notice:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2673
        it is VERY questionable, if it makes sense to add manual
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2674
        type checks to a dynamically typed language like smalltalk. 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2675
        It will, at least, slow down performance,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2676
        make your code less reusable and clutter your code with stupid sends
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2677
        of this selector. Also, read the comment in isKindOf:, regarding the
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2678
        use of isXXX check methods.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2679
     You see: The author does not like this at all ..."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2680
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2681
    (self isKindOf:aClass) ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2682
        self error:'argument is not of expected type'
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2683
    ]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2684
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2685
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2686
obsoleteMethodWarning
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2687
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2688
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2689
    "in methods which are going to be obsoleted, a self send to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2690
     this method is used to tell programmers that a method is
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2691
     used which is going to be removed in later ST/X versions.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2692
     Find all methods which will be obsolete soon by looking at senders
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2693
     of this message.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2694
     Hopefully, this warning message is annoying enough for you to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2695
     change the code ... ;-)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2696
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2697
    self obsoleteMethodWarning:nil from:thisContext sender
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2698
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2699
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2700
obsoleteMethodWarning:message
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2701
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2702
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2703
    "in methods which are going to be obsoleted, a self send to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2704
     this method is used to tell programmers that a method is
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2705
     used which is going to be removed in later ST/X versions.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2706
     Find all methods which will be obsolete soon by looking at senders
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2707
     of this message.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2708
     Hopefully, this warning message is annoying enough for you to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2709
     change the code ... ;-)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2710
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2711
    self obsoleteMethodWarning:message from:thisContext sender
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2712
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2713
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2714
obsoleteMethodWarning:message from:aContext
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2715
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  2716
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2717
    "in methods which are going to be obsoleted, a self-send to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2718
     this method is used to tell programmers that a method is
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2719
     used which is going to be removed in later ST/X versions.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2720
     Find all methods which will be obsolete soon by looking at senders
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2721
     of this message.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2722
     Hopefully, this warning message is annoying enough for you to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2723
     change the code ... ;-)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2724
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2725
    |spec|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2726
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2727
    spec := aContext methodPrintString.
2136
36c63754670a *PrintNL eliminated
Claus Gittinger <cg@exept.de>
parents: 2132
diff changeset
  2728
    ('WARNING: the ''' , spec , ''' method is obsolete.') errorPrintCR.
36c63754670a *PrintNL eliminated
Claus Gittinger <cg@exept.de>
parents: 2132
diff changeset
  2729
    ('         And may not be present in future ST/X versions.') errorPrintCR.
36c63754670a *PrintNL eliminated
Claus Gittinger <cg@exept.de>
parents: 2132
diff changeset
  2730
    ('         called from ' , aContext sender printString) errorPrintCR.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2731
    message notNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2732
        '------>  ' errorPrint. message errorPrintCR
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2733
    ]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2734
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2735
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2736
     Object obsoleteMethodWarning:'foo' from:thisContext sender sender
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2737
    "
2136
36c63754670a *PrintNL eliminated
Claus Gittinger <cg@exept.de>
parents: 2132
diff changeset
  2738
36c63754670a *PrintNL eliminated
Claus Gittinger <cg@exept.de>
parents: 2132
diff changeset
  2739
    "Modified: 10.1.1997 / 19:08:42 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2740
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2741
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2742
!Object methodsFor:'dependents access'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2743
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2744
addDependent:anObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2745
    "make the argument, anObject be a dependent of the receiver"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2746
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2747
    |wasBlocked|
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2748
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2749
    "/ must do this save from interrupts, since the dependents collection
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2750
    "/ is possibly accessed from multiple threads.
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2751
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2752
    "/ faster execution.
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2753
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2754
    wasBlocked := OperatingSystem blockInterrupts.
863
2c83fe958ca7 change dependencies uninterruptably
Claus Gittinger <cg@exept.de>
parents: 861
diff changeset
  2755
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2756
        |deps dep|
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2757
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2758
        deps := self dependents.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2759
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2760
        "/ to save a fair amount of memory in case of
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2761
        "/ many dependencies, we store a single dependent in
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2762
        "/ a WeakArray, and switch to a WeakSet if more dependents are
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2763
        "/ added.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2764
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2765
        (deps isNil or:[deps size == 0]) ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2766
            self dependents:(WeakArray with:anObject)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2767
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2768
            deps class == WeakArray ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2769
                dep := deps at:1.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2770
                dep ~~ anObject ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2771
                    (dep isNil or:[dep == 0]) ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2772
                        deps at:1 put:anObject
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2773
                    ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2774
                        self dependents:(WeakIdentitySet with:dep with:anObject)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2775
                    ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2776
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2777
            ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2778
                deps add:anObject
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2779
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2780
        ]
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2781
    ] valueNowOrOnUnwindDo:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2782
        wasBlocked ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2783
            OperatingSystem unblockInterrupts
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2784
        ]
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2785
    ]
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2786
3063
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  2787
    "Modified: / 27.10.1997 / 19:35:52 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2788
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2789
3309
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2790
breakDependents
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2791
    "remove all dependencies from the receiver"
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2792
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2793
    self dependents:nil.
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2794
    self nonWeakDependents:nil
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2795
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2796
    "Modified: / 19.4.1996 / 10:55:36 / cg"
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2797
    "Created: / 27.2.1998 / 11:26:11 / stefan"
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2798
!
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2799
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2800
dependents
3222
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2801
    "return a Collection of dependents.
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  2802
     The default implementation here uses a global WeakDictionary to store
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  2803
     dependents 
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  2804
     This may be too slow for high frequency change&update,
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  2805
     therefore, some classes (Model) redefine this for better performance.
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  2806
     Notice the mentioning of a WeakDictionary - read the classes documentation."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2807
3222
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2808
    |deps|
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2809
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2810
    (deps := Dependencies at:self ifAbsent:nil) isNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2811
        ^ #().
3222
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2812
    ].
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2813
    ^ deps
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2814
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2815
    "Modified: / 26.1.1998 / 11:18:15 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2816
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2817
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2818
dependents:aCollection
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2819
    "set the collection of dependents.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2820
     The default implementation here uses a global Dictionary to store
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2821
     dependents which may be too slow for high frequency change&update.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2822
     Therefore, some classes (Model) redefine this for better performance."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2823
1624
50c5849dc9d4 mhmh - care for dependent being already in the array,
Claus Gittinger <cg@exept.de>
parents: 1611
diff changeset
  2824
    "/ must do this save from interrupts, since the dependents collection
50c5849dc9d4 mhmh - care for dependent being already in the array,
Claus Gittinger <cg@exept.de>
parents: 1611
diff changeset
  2825
    "/ is possibly accessed from multiple threads.
50c5849dc9d4 mhmh - care for dependent being already in the array,
Claus Gittinger <cg@exept.de>
parents: 1611
diff changeset
  2826
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
2336
45f63b0d8832 tuned #dependents:
Claus Gittinger <cg@exept.de>
parents: 2327
diff changeset
  2827
    "/ faster execution (and to avoid creation of garbage blocks).
45f63b0d8832 tuned #dependents:
Claus Gittinger <cg@exept.de>
parents: 2327
diff changeset
  2828
45f63b0d8832 tuned #dependents:
Claus Gittinger <cg@exept.de>
parents: 2327
diff changeset
  2829
    (OperatingSystem blockInterrupts) ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2830
        "/ the common case - already blocked
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2831
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2832
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
5424
3ffaef20cfd0 removeKey:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 5421
diff changeset
  2833
            Dependencies removeKey:self ifAbsent:nil
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2834
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2835
            Dependencies at:self put:aCollection
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2836
        ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2837
        ^ self
2336
45f63b0d8832 tuned #dependents:
Claus Gittinger <cg@exept.de>
parents: 2327
diff changeset
  2838
    ].
45f63b0d8832 tuned #dependents:
Claus Gittinger <cg@exept.de>
parents: 2327
diff changeset
  2839
863
2c83fe958ca7 change dependencies uninterruptably
Claus Gittinger <cg@exept.de>
parents: 861
diff changeset
  2840
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2841
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
5424
3ffaef20cfd0 removeKey:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 5421
diff changeset
  2842
            Dependencies removeKey:self ifAbsent:nil
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2843
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2844
            Dependencies at:self put:aCollection
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2845
        ].
1624
50c5849dc9d4 mhmh - care for dependent being already in the array,
Claus Gittinger <cg@exept.de>
parents: 1611
diff changeset
  2846
    ] valueNowOrOnUnwindDo:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2847
        OperatingSystem unblockInterrupts
1624
50c5849dc9d4 mhmh - care for dependent being already in the array,
Claus Gittinger <cg@exept.de>
parents: 1611
diff changeset
  2848
    ]
50c5849dc9d4 mhmh - care for dependent being already in the array,
Claus Gittinger <cg@exept.de>
parents: 1611
diff changeset
  2849
2336
45f63b0d8832 tuned #dependents:
Claus Gittinger <cg@exept.de>
parents: 2327
diff changeset
  2850
    "Modified: 30.1.1997 / 21:22:10 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2851
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2852
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2853
dependentsDo:aBlock
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2854
    "evaluate aBlock for all of my dependents"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2855
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  2856
    |deps nwDeps|
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2857
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2858
    deps := self dependents.
3222
f5f820763b97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3177
diff changeset
  2859
    deps size ~~ 0 ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2860
        deps do:[:d | 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2861
                    (d notNil and:[d ~~ 0]) ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2862
                        aBlock value:d
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2863
                    ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2864
                ]
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2865
    ].
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  2866
    nwDeps := self nonWeakDependents.
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2867
    (nwDeps ~~ deps and:[nwDeps size ~~ 0]) ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2868
        nwDeps do:aBlock 
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2869
    ].
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2870
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2871
    "Modified: / 30.1.1998 / 14:03:40 / cg"
1098
e8543399e2a0 support aspect-specific interests
Claus Gittinger <cg@exept.de>
parents: 1097
diff changeset
  2872
!
e8543399e2a0 support aspect-specific interests
Claus Gittinger <cg@exept.de>
parents: 1097
diff changeset
  2873
2445
efd1b24db615 added #myDependents
ca
parents: 2437
diff changeset
  2874
myDependents
efd1b24db615 added #myDependents
ca
parents: 2437
diff changeset
  2875
    "same as dependents - ST-80 compatibility"
efd1b24db615 added #myDependents
ca
parents: 2437
diff changeset
  2876
efd1b24db615 added #myDependents
ca
parents: 2437
diff changeset
  2877
    ^ self dependents
efd1b24db615 added #myDependents
ca
parents: 2437
diff changeset
  2878
!
efd1b24db615 added #myDependents
ca
parents: 2437
diff changeset
  2879
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2880
release
3309
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2881
    "remove all references to objects that may refer to self.
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2882
     Subclasses may redefine this method but should do a 'super release'."
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2883
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2884
    self breakDependents
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2885
3e24bdf9ba79 Define #breakDependents (ST80 compat, needed by STBroker).
Stefan Vogel <sv@exept.de>
parents: 3306
diff changeset
  2886
    "Modified: / 27.2.1998 / 11:29:35 / stefan"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2887
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2888
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2889
removeDependent:anObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2890
    "make the argument, anObject be independent of the receiver"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  2891
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2892
    |wasBlocked|
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2893
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2894
    "/ must do this save from interrupts, since the dependents collection
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2895
    "/ is possibly accessed from multiple threads.
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2896
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2897
    "/ faster execution.
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2898
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2899
    wasBlocked := OperatingSystem blockInterrupts.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2900
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2901
        |deps n d|
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2902
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2903
        deps := self dependents.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2904
        deps size ~~ 0 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2905
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2906
            "/ to save a fair amount of memory in case of
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2907
            "/ many dependencies, we store a single dependent in
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2908
            "/ a WeakArray, and switch to a WeakSet if more dependents are
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2909
            "/ added. Here we have to do the inverse ...
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2910
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2911
            deps class == WeakArray ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2912
                ((d := deps at:1) == anObject 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2913
                or:[d isNil
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2914
                or:[d == 0]]) ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2915
                    self dependents:nil
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2916
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2917
            ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2918
                deps remove:anObject ifAbsent:[].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2919
                (n := deps size) == 0 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2920
                    self dependents:nil
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2921
                ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2922
                    n == 1 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2923
                        d := deps firstIfEmpty:nil.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2924
                        d notNil ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2925
                            deps := WeakArray with:d
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2926
                        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2927
                            deps := nil
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2928
                        ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2929
                        self dependents:deps.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2930
                    ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2931
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2932
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2933
        ]
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2934
    ] valueNowOrOnUnwindDo:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2935
        wasBlocked ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2936
            OperatingSystem unblockInterrupts
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2937
        ]
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2938
    ]
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2939
3228
b6b893e8f898 must look for size of value returned by self dependents
Claus Gittinger <cg@exept.de>
parents: 3222
diff changeset
  2940
    "Modified: / 26.1.1998 / 19:51:50 / cg"
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2941
! !
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2942
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2943
!Object methodsFor:'dependents access (nonWeak)'!
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2944
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2945
addNonWeakDependent:anObject
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2946
    "make the argument, anObject be a nonWeak dependent of the receiver.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2947
     Be careful: this nonWeakDependency will prevent the dependent from being 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2948
     garbage collected unless the dependency is removed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2949
     This is a private mechanism, for directed dependencies."
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2950
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2951
    |wasBlocked|
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2952
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2953
    "/ must do this save from interrupts, since the dependents collection
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2954
    "/ is possibly accessed from multiple threads.
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2955
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2956
    "/ faster execution.
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2957
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2958
    wasBlocked := OperatingSystem blockInterrupts.
863
2c83fe958ca7 change dependencies uninterruptably
Claus Gittinger <cg@exept.de>
parents: 861
diff changeset
  2959
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2960
        |deps dep|
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2961
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2962
        deps := self nonWeakDependents.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2963
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2964
        "/ to save a fair amount of memory in case of
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2965
        "/ many dependencies, we store a single dependent in
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2966
        "/ an Array, and switch to a Set if more dependents are
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2967
        "/ added.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2968
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2969
        deps size == 0 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2970
            self nonWeakDependents:(Array with:anObject)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2971
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2972
            deps class == Array ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2973
                dep := deps at:1.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2974
                dep ~~ anObject ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2975
                    self nonWeakDependents:(IdentitySet with:dep with:anObject)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2976
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2977
            ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2978
                deps add:anObject
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2979
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2980
        ]
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2981
    ] valueNowOrOnUnwindDo:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2982
        wasBlocked ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2983
            OperatingSystem unblockInterrupts
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  2984
        ]
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  2985
    ]
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2986
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2987
    "Created: / 19.4.1996 / 10:54:08 / cg"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2988
    "Modified: / 30.1.1998 / 14:03:08 / cg"
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2989
!
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2990
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2991
nonWeakDependents
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2992
    "return a Collection of nonWeakDependents - empty if there is none.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2993
     This is a private mechanism for directed dependencies."
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  2994
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2995
    NonWeakDependencies isNil ifTrue:[^ #()].
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2996
    ^ NonWeakDependencies at:self ifAbsent:#()
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2997
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2998
    "Created: / 19.4.1996 / 10:55:06 / cg"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  2999
    "Modified: / 30.1.1998 / 14:06:47 / cg"
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3000
!
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3001
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3002
nonWeakDependents:aCollection
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3003
    "set the collection of nonWeak dependents.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3004
     This is a private helper for directed dependencies."
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3005
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3006
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3007
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
5424
3ffaef20cfd0 removeKey:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 5421
diff changeset
  3008
            NonWeakDependencies removeKey:self ifAbsent:nil
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3009
        ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3010
            NonWeakDependencies at:self put:aCollection
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3011
        ]
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3012
    ] valueUninterruptably
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3013
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3014
    "Created: 19.4.1996 / 11:07:47 / cg"
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3015
!
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3016
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3017
removeNonWeakDependent:anObject
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3018
    "remove a nonWeak dependency from the receiver to the argument, anObject.
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3019
     (i.e. make it independent of the receiver)"
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3020
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3021
    |wasBlocked|
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3022
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3023
    "/ must do this save from interrupts, since the dependents collection
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3024
    "/ is possibly accessed from multiple threads.
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3025
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3026
    "/ faster execution.
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3027
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3028
    wasBlocked := OperatingSystem blockInterrupts.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3029
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3030
        |deps n|
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3031
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3032
        deps := self nonWeakDependents.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3033
        deps size ~~ 0 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3034
            deps class == Array ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3035
                (deps at:1) == anObject ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3036
                    self nonWeakDependents:nil
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3037
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3038
            ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3039
                deps remove:anObject ifAbsent:[].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3040
                (n := deps size) == 0 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3041
                    self nonWeakDependents:nil
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3042
                ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3043
                    n == 1 ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3044
                        self nonWeakDependents:(Array with:(deps first))
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3045
                    ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3046
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3047
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3048
        ]
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3049
    ] valueNowOrOnUnwindDo:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3050
        wasBlocked ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3051
            OperatingSystem unblockInterrupts
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3052
        ]
1585
5cfa7f2586ad use inline interrupt blocking in dependents acces methods.
Claus Gittinger <cg@exept.de>
parents: 1533
diff changeset
  3053
    ]
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3054
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3055
    "Created: / 19.4.1996 / 11:44:44 / cg"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3056
    "Modified: / 30.1.1998 / 14:04:01 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3057
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3058
3023
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3059
!Object methodsFor:'displaying'!
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3060
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3061
displayOn:aGC
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3062
    "ST-80 Compatibility
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3063
     display the receiver in a graphicsContext at 0@0
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3064
     - this method allows for any object to be displayed in some view
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3065
     (although the fallBack is to display its printString ...)"
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3066
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3067
    ^ self displayOn:aGC x:0 y:0.
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3068
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3069
    "Created: 29.5.1996 / 16:28:58 / cg"
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3070
!
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3071
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3072
displayOn:aGC at:aPoint
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3073
    "ST-80 Compatibility
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3074
     display the receiver in a graphicsContext - this method allows
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3075
     for any object to be displayed in a ListView - for example."
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3076
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3077
    ^ self displayOn:aGC x:(aPoint x) y:(aPoint y).
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3078
!
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3079
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3080
displayOn:aGC x:x y:y
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3081
    "display the receiver in a graphicsContext - this method allows
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3082
     for any object to be displayed in a ListView - for example."
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3083
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3084
    self displayOn:aGC x:x y:y opaque:false
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3085
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3086
    "Modified: 29.5.1996 / 16:29:38 / cg"
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3087
!
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3088
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3089
displayOn:aGc x:x y:y opaque:opaque
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3090
    "display the receiver in a graphicsContext - this method allows
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3091
     for any object to be displayed in a ListView - for example.
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3092
     The fallBack here shows the receivers displayString."
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3093
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3094
    |s|
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3095
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3096
    s := self displayString.
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3097
    opaque ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3098
        aGc displayOpaqueString:s x:x y:y.
3023
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3099
    ] ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3100
        aGc displayString:s x:x y:y.
3023
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3101
    ].
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3102
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3103
    "Modified: 29.5.1996 / 16:29:38 / cg"
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3104
!
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3105
3063
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3106
displayOpaqueOn:aGC x:x y:y
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3107
    "display the receiver in a graphicsContext - this method allows
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3108
     for any object to be displayed in a ListView - for example."
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3109
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3110
    self displayOn:aGC x:x y:y opaque:true
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3111
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3112
    "Modified: / 29.5.1996 / 16:29:38 / cg"
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3113
    "Created: / 26.10.1997 / 15:01:36 / cg"
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3114
!
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3115
3023
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3116
displayString
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3117
    "return a string used when displaying the receiver in a view;
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3118
     for example an Inspector. This is usually the same as printString,
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3119
     but sometimes redefined for a better look."
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3120
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3121
    ^ self printString
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3122
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3123
    "
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3124
     #(1 2 3) printString    
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3125
     #(1 2 3) displayString  
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3126
     #(1 2 3) storeString
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3127
    "
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3128
!
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3129
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3130
heightOn:aGC
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3131
    "return the height of the receiver, if it is to be displayed on aGC"
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3132
4603
fdd11551483d #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 4600
diff changeset
  3133
    ^ (aGC font onDevice:aGC device) heightOf:(self displayString)
3023
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3134
!
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3135
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3136
widthOn:aGC
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3137
    "return the width of the receiver, if it is to be displayed on aGC"
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3138
4603
fdd11551483d #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 4600
diff changeset
  3139
    ^ (aGC font onDevice:aGC device) widthOf:(self displayString)
3023
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3140
! !
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
  3141
4808
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3142
!Object methodsFor:'encoding & decoding'!
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3143
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3144
decodeAsLiteralArray
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3145
    ^ self
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3146
!
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3147
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3148
fromLiteralArrayEncoding:aSpecArray
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3149
    "read my attributes from aSpecArray
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3150
    "
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3151
    |sel val
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3152
     stop   "{ Class:SmallInteger }" |
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3153
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3154
    stop := aSpecArray size.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3155
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3156
    2 to:stop by:2 do:[:i|
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3157
        sel := aSpecArray at:i.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3158
        val := aSpecArray at:i + 1.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3159
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3160
        (self respondsTo:sel) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3161
            self perform:sel with:(val decodeAsLiteralArray)
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3162
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3163
            Transcript show:self class name; show:': unhandled literalArrayEncoding attribute: '.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3164
            Transcript showCR:sel.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3165
        ]
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3166
    ]
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3167
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3168
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3169
!
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3170
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3171
literalArrayEncoding
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3172
    "generate a literalArrayEncoding array for myself.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3173
     This uses #literalArrayEncodingSlotOrder which defines the slots and
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3174
     order and #skippedInLiteralEncoding which defines slots to skip.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3175
     For most subclasses, there is no need to redefine those."
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3176
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3177
    |names encoding cls skipped|
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3178
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3179
    self isLiteral ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3180
        ^ self
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3181
    ].
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3182
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3183
    skipped  := self skippedInLiteralEncoding.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3184
    cls      := self class.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3185
    names    := cls allInstVarNames.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3186
    encoding := OrderedCollection with:(cls name).
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3187
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3188
    (self literalArrayEncodingSlotOrder) do:[:instSlot |
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3189
        |value nm|
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3190
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3191
        nm := names at:instSlot.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3192
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3193
        (skipped includes:nm) ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3194
            (value := self instVarAt:instSlot) notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3195
                encoding add:(nm , ':') asSymbol.
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3196
                encoding add:value literalArrayEncoding
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3197
            ]
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3198
        ]
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3199
    ].
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3200
    ^ encoding asArray
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3201
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3202
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3203
!
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3204
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3205
literalArrayEncodingSlotOrder
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3206
    "define the order in which inst-slots are saved when generating
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3207
     a literalArrayEncoding
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3208
    "
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3209
    ^ 1 to:self class instSize
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3210
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3211
!
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3212
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3213
skippedInLiteralEncoding
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3214
    "return a Collection with it's elements are slots for skipping
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3215
    "
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3216
    ^ #()
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3217
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3218
! !
Claus Gittinger <cg@exept.de>
parents: 4799
diff changeset
  3219
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3220
!Object methodsFor:'error handling'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3221
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3222
appropriateDebugger:aSelector
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3223
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3224
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3225
    "return an appropriate debugger to use.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3226
     If there is already a debugger active on the stack, and it is
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3227
     the DebugView, return MiniDebugger (as a last chance) otherwise abort."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3228
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3229
    |context|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3230
1678
1c0fc4e322d0 Change #appropriateDebugger: to call Minidebugger when being called by
Stefan Vogel <sv@exept.de>
parents: 1674
diff changeset
  3231
    "DebugView cannot run without system processes"
1c0fc4e322d0 Change #appropriateDebugger: to call Minidebugger when being called by
Stefan Vogel <sv@exept.de>
parents: 1674
diff changeset
  3232
1685
5f867e93af8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1684
diff changeset
  3233
    (Processor isNil 
4208
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3234
    or:[Processor activeProcessIsSystemProcess
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3235
    or:[Smalltalk isInitialized not]]) ifTrue:[
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3236
        ^ MiniDebugger
1678
1c0fc4e322d0 Change #appropriateDebugger: to call Minidebugger when being called by
Stefan Vogel <sv@exept.de>
parents: 1674
diff changeset
  3237
    ].
5180
8b625cdc8cef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5149
diff changeset
  3238
    (Screen isNil or:[Screen default isNil]) ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3239
        Debugger isNil ifTrue:[^ Debugger].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3240
        ^ MiniDebugger
5180
8b625cdc8cef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5149
diff changeset
  3241
    ].
1678
1c0fc4e322d0 Change #appropriateDebugger: to call Minidebugger when being called by
Stefan Vogel <sv@exept.de>
parents: 1674
diff changeset
  3242
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3243
    context := thisContext.
2893
8ba406da6b22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2851
diff changeset
  3244
    context := context findNextContextWithSelector:aSelector or:nil or:nil.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3245
    [context notNil] whileTrue:[
4208
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3246
        ((context receiver class == Debugger) 
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3247
         and:[context selector == aSelector]) ifTrue:[
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3248
            "we are already in some Debugger"
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3249
            (Debugger == MiniDebugger) ifTrue:[
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3250
                "we are already in the MiniDebugger"
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3251
                ErrorRecursion ifFalse:[
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3252
                    Smalltalk fatalAbort:'recursive error ...'
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3253
                ]
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3254
            ].
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3255
            MiniDebugger isNil ifTrue:[
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3256
                Smalltalk fatalAbort:'no debugger'
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3257
            ].
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3258
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3259
            "ok, an error occured while in the graphical debugger;
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3260
             lets try MiniDebugger"
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3261
            ^ MiniDebugger
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3262
        ].
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3263
        context := context findNextContextWithSelector:aSelector or:nil or:nil.
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3264
    ].
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3265
    "not within Debugger - no problem"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3266
    ^ Debugger
1678
1c0fc4e322d0 Change #appropriateDebugger: to call Minidebugger when being called by
Stefan Vogel <sv@exept.de>
parents: 1674
diff changeset
  3267
3063
d4bc0c596b98 dependents always returns a collection.
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3268
    "Modified: / 23.9.1996 / 12:14:52 / stefan"
4208
fb27208e08f1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4103
diff changeset
  3269
    "Modified: / 19.5.1999 / 18:05:00 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3270
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3271
2229
a9881102b243 new feature: cannotSendMessage:to:
Claus Gittinger <cg@exept.de>
parents: 2227
diff changeset
  3272
cannotSendMessage:aMessage to:someReceiver
a9881102b243 new feature: cannotSendMessage:to:
Claus Gittinger <cg@exept.de>
parents: 2227
diff changeset
  3273
    "this message is sent by the runtime system (VM),
a9881102b243 new feature: cannotSendMessage:to:
Claus Gittinger <cg@exept.de>
parents: 2227
diff changeset
  3274
     when a message is sent to some object, whose class is not
2231
88ffbbaf1986 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2229
diff changeset
  3275
     a valid behavior (see documentation in Behavior)."
2229
a9881102b243 new feature: cannotSendMessage:to:
Claus Gittinger <cg@exept.de>
parents: 2227
diff changeset
  3276
a9881102b243 new feature: cannotSendMessage:to:
Claus Gittinger <cg@exept.de>
parents: 2227
diff changeset
  3277
    ^ InternalErrorSignal
4469
8719f53c8151 dont raise nonProceedable InternalErrorSignal proceedable.
Claus Gittinger <cg@exept.de>
parents: 4452
diff changeset
  3278
          raiseWith:someReceiver
8719f53c8151 dont raise nonProceedable InternalErrorSignal proceedable.
Claus Gittinger <cg@exept.de>
parents: 4452
diff changeset
  3279
          errorString:('bad class in send of #' , aMessage selector)
2231
88ffbbaf1986 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2229
diff changeset
  3280
88ffbbaf1986 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2229
diff changeset
  3281
    "Modified: 23.1.1997 / 00:05:39 / cg"
2229
a9881102b243 new feature: cannotSendMessage:to:
Claus Gittinger <cg@exept.de>
parents: 2227
diff changeset
  3282
!
a9881102b243 new feature: cannotSendMessage:to:
Claus Gittinger <cg@exept.de>
parents: 2227
diff changeset
  3283
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3284
doesNotUnderstand:aMessage
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3285
    "this message is sent by the runtime system (VM) when
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3286
     a message is not understood by some object (i.e. there
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3287
     is no method for that selector). The original message has
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3288
     been packed into aMessage (i.e. the receiver, selector and
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3289
     any arguments) and the original receiver is then sent the
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3290
     #doesNotUnderstand: message.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3291
     Here, we raise another signal which usually enters the debugger.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3292
     You can of course redefine #doesNotUnderstand: in your classes
1327
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3293
     to implement message delegation, 
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3294
     or handle the MessageNotUnderstoodSignal gracefully."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3295
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3296
    <context: #return>
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3297
4287
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3298
    |sel selStr errorString cls sender|
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3299
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3300
    sel := aMessage selector.
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3301
    selStr := sel printString.
2818
58125948706b care for bad selector in #doesNotUnderstand:
Claus Gittinger <cg@exept.de>
parents: 2774
diff changeset
  3302
58125948706b care for bad selector in #doesNotUnderstand:
Claus Gittinger <cg@exept.de>
parents: 2774
diff changeset
  3303
    "/ Although sel should always be a symbol,
58125948706b care for bad selector in #doesNotUnderstand:
Claus Gittinger <cg@exept.de>
parents: 2774
diff changeset
  3304
    "/ always use printStrings in the code below.
58125948706b care for bad selector in #doesNotUnderstand:
Claus Gittinger <cg@exept.de>
parents: 2774
diff changeset
  3305
    "/ Non-symbol selector may happen when things go mad in a primitive, 
58125948706b care for bad selector in #doesNotUnderstand:
Claus Gittinger <cg@exept.de>
parents: 2774
diff changeset
  3306
    "/ or a method has been called by valueWithReceiver: with a wrong arg.
58125948706b care for bad selector in #doesNotUnderstand:
Claus Gittinger <cg@exept.de>
parents: 2774
diff changeset
  3307
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3308
    "/ handle the case of an error during early startup
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3309
    "/ (output streams not yet initialized)
2818
58125948706b care for bad selector in #doesNotUnderstand:
Claus Gittinger <cg@exept.de>
parents: 2774
diff changeset
  3310
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3311
    Stdout isNil ifTrue:[
4287
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3312
        Smalltalk fatalAbort:'error during init: ' , selStr , ' not understood'.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3313
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3314
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3315
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3316
    "/ extract the class that should have implemented the message.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3317
    "/ (in case of a super-send, this is not the receivers class)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3318
    "/
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3319
    cls := thisContext sender searchClass.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3320
    cls isNil ifTrue:[
4287
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3321
        "it was NOT a super or directed send ..."
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3322
        cls := self class
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3323
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3324
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3325
    cls notNil ifTrue:[
4287
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3326
        "/
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3327
        "/ displayString is better than 'cls name',
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3328
        "/ since it appends (obsolete) for outdated classes.
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3329
        "/ (this happens if you send messages to old instances
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3330
        "/  after changing a classes definition)
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3331
        "/
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3332
        errorString := cls displayString.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3333
    ] ifFalse:[    
4287
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3334
        errorString := '(** nil-class **)'
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3335
    ].
4287
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3336
    sel class ~~ Symbol ifTrue:[
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3337
        errorString := errorString , ' nonSymbol selector: ' , selStr , ' not understood'.
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3338
    ] ifFalse:[
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3339
        errorString := errorString , ' does not understand: ' , selStr.
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3340
    ].
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3341
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3342
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3343
    "/ this only happens, when YOU play around with my classvars ...
1327
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3344
    "/ (or an error occurs during very early startup, when signals are not yet set)
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3345
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3346
    MessageNotUnderstoodSignal isNil ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3347
        ^ MiniDebugger 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3348
            enterWithMessage:'oops - MessageNotUnderstoodSignal is gone (nil)'
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3349
            mayProceed:true.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3350
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3351
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3352
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3353
    "/ thats where we end up normally - raise a signal which (if unhandled) opens a debugger
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3354
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3355
    ^ MessageNotUnderstoodSignal
4287
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3356
                raiseRequestWith:aMessage
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3357
                errorString:errorString
4287
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3358
cb4ae74a5c11 better errorString when selector is not a symbol
Claus Gittinger <cg@exept.de>
parents: 4267
diff changeset
  3359
    "Modified: / 9.6.1999 / 17:46:17 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3360
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3361
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3362
elementBoundsError
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3363
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3364
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3365
    "report an error that badElement is out of bounds 
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3366
     (i.e. cannot be put into that collection).
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3367
     The error is reported by raising the ElementOutOfBoundsSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3368
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3369
    ^ ElementOutOfBoundsSignal raise
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3370
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3371
    "Modified: 8.5.1996 / 09:12:45 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3372
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3373
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3374
elementNotCharacter
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3375
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3376
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3377
    "report an error that object to be stored is no Character.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3378
     (usually when storing into Strings).
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3379
     The error is reported by raising the ElementOutOfBoundsSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3380
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3381
    ^ ElementOutOfBoundsSignal raise
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3382
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3383
    "Modified: 8.5.1996 / 09:12:49 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3384
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3385
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3386
elementNotInteger
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3387
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3388
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3389
    "report an error that object to be stored is not Integer.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3390
     (in collections that store integers only).
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3391
     The error is reported by raising the ElementOutOfBoundsSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3392
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3393
    ^ ElementOutOfBoundsSignal raise
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3394
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3395
    "Modified: 8.5.1996 / 09:12:51 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3396
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3397
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3398
error
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3399
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3400
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3401
    <context: #return>
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3402
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3403
    "report error that an error occured.
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3404
     The error is reported by raising the Error exception,
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3405
     which is non-proceedable.
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3406
     If no handler has been setup, a debugger is entered."
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3407
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3408
    Error raiseWith:#error:
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3409
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3410
    "
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3411
     nil error
4529
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3412
    "
4452
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3413
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3414
    "Modified: / 8.5.1996 / 09:13:01 / cg"
4499
251d4c698581 Send #halt resp. #error as signal parameter in these methods.
Stefan Vogel <sv@exept.de>
parents: 4469
diff changeset
  3415
    "Modified: / 2.8.1999 / 17:00:19 / stefan"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3416
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3417
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3418
error:aString
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3419
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3420
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3421
    <context: #return>
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3422
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3423
    "Raise an error with error message aString.
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3424
     The error is reported by raising the Error exception,
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3425
     which is non-proceedable.
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3426
     If no handler has been setup, a debugger is entered."
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3427
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3428
    Error raiseWith:#error: errorString:aString 
4529
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3429
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3430
    "
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3431
      nil error:' bad bad bad'
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3432
    "
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3433
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3434
    "Modified: 8.5.1996 / 09:13:04 / cg"
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3435
!
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3436
4529
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3437
error:aString mayProceed:mayProceed
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3438
    "{ Pragma: +optSpace }"
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3439
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3440
    "enter debugger with error-message aString.
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3441
     The error is reported by raising either the 
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3442
     non-proceedable Error exception,
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3443
     or the ProceedableError exception."
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3444
4529
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3445
    mayProceed ifTrue:[
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3446
        ^ ProceedableError raiseRequestWith:#error: errorString:aString 
4529
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3447
    ].
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3448
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3449
    Error raiseWith:#error: errorString:aString 
4529
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3450
b594b60be7c4 New method #error:mayProceed
Stefan Vogel <sv@exept.de>
parents: 4522
diff changeset
  3451
    "Modified: 8.5.1996 / 09:13:04 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3452
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3453
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3454
errorKeyNotFound:aKey
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3455
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3456
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3457
    "report an error that a key was not found in a collection.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3458
     The error is reported by raising the KeyNotFoundSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3459
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3460
    ^ KeyNotFoundSignal raiseRequestWith:aKey
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3461
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3462
    "
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3463
     #(1 2) at:3
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3464
    "
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3465
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3466
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3467
errorNotFound
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3468
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3469
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3470
    "report an error that no element was found in a collection.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3471
     The error is reported by raising the NotFoundSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3472
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3473
    ^ NotFoundSignal raiseRequestWith:nil
4452
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3474
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3475
    "Modified: / 8.5.1996 / 09:13:11 / cg"
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3476
    "Modified: / 26.7.1999 / 10:51:50 / stefan"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3477
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3478
3622
5b1e8a260a64 added instance>>errorSignal
Claus Gittinger <cg@exept.de>
parents: 3598
diff changeset
  3479
errorSignal
5b1e8a260a64 added instance>>errorSignal
Claus Gittinger <cg@exept.de>
parents: 3598
diff changeset
  3480
    ^ self class errorSignal
5b1e8a260a64 added instance>>errorSignal
Claus Gittinger <cg@exept.de>
parents: 3598
diff changeset
  3481
5b1e8a260a64 added instance>>errorSignal
Claus Gittinger <cg@exept.de>
parents: 3598
diff changeset
  3482
    "Created: / 19.6.1998 / 02:32:32 / cg"
5b1e8a260a64 added instance>>errorSignal
Claus Gittinger <cg@exept.de>
parents: 3598
diff changeset
  3483
!
5b1e8a260a64 added instance>>errorSignal
Claus Gittinger <cg@exept.de>
parents: 3598
diff changeset
  3484
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3485
halt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3486
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3487
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3488
    "enter debugger with halt-message.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3489
     The error is reported by raising the HaltSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3490
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3491
    ^ HaltSignal raiseRequestWith:#halt
4452
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3492
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3493
    "Modified: / 8.5.1996 / 09:12:38 / cg"
4499
251d4c698581 Send #halt resp. #error as signal parameter in these methods.
Stefan Vogel <sv@exept.de>
parents: 4469
diff changeset
  3494
    "Modified: / 2.8.1999 / 17:00:29 / stefan"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3495
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3496
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3497
halt:aString
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3498
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3499
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3500
    "enter debugger with halt-message.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3501
     The error is reported by raising the HaltSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3502
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3503
    ^ HaltSignal raiseRequestWith:#halt: errorString:aString
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3504
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3505
    "Modified: 8.5.1996 / 09:13:23 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3506
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3507
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3508
implementedBySubclass
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3509
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3510
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3511
    "this is sent by ST/V code - its the same as #subclassResponsibility"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3512
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3513
    ^ self subclassResponsibility
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3514
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3515
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3516
indexNotInteger
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3517
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3518
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3519
    "report an error that index is not an Integer.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3520
     (when accessing collections indexed by an integer key).
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3521
     The error is reported by raising the NonIntegerIndexSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3522
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3523
    ^ NonIntegerIndexSignal raiseRequestWith:nil
4452
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3524
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3525
    "Modified: / 8.5.1996 / 09:13:37 / cg"
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3526
    "Modified: / 26.7.1999 / 10:57:43 / stefan"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3527
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3528
3450
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3529
indexNotInteger:anIndex
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3530
    "{ Pragma: +optSpace }"
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3531
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3532
    "report an error that index is not an Integer.
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3533
     (when accessing collections indexed by an integer key).
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3534
     The error is reported by raising the NonIntegerIndexSignal exception."
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3535
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3536
    ^ NonIntegerIndexSignal raiseRequestWith:anIndex 
3450
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3537
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3538
    "Created: / 16.5.1998 / 19:39:41 / cg"
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3539
!
8e2ebfb882bd added indexNotInteger: (i.e. with argument)
Claus Gittinger <cg@exept.de>
parents: 3437
diff changeset
  3540
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3541
integerCheckError
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3542
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3543
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3544
    "generated when a variable declared with an integer type gets a bad
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3545
     value assigned"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3546
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3547
    ^ self error:'bad assign of ' , self printString , 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3548
                  ' (' , self class name , ') to integer-typed variable'
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3549
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3550
2829
909f31cc9b0b must provide #invalidCodeObject
Claus Gittinger <cg@exept.de>
parents: 2819
diff changeset
  3551
invalidCodeObject
909f31cc9b0b must provide #invalidCodeObject
Claus Gittinger <cg@exept.de>
parents: 2819
diff changeset
  3552
    "{ Pragma: +optSpace }"
909f31cc9b0b must provide #invalidCodeObject
Claus Gittinger <cg@exept.de>
parents: 2819
diff changeset
  3553
909f31cc9b0b must provide #invalidCodeObject
Claus Gittinger <cg@exept.de>
parents: 2819
diff changeset
  3554
    self error:'not an executable code object'
909f31cc9b0b must provide #invalidCodeObject
Claus Gittinger <cg@exept.de>
parents: 2819
diff changeset
  3555
909f31cc9b0b must provide #invalidCodeObject
Claus Gittinger <cg@exept.de>
parents: 2819
diff changeset
  3556
    "Created: 1.8.1997 / 00:16:44 / cg"
909f31cc9b0b must provide #invalidCodeObject
Claus Gittinger <cg@exept.de>
parents: 2819
diff changeset
  3557
!
909f31cc9b0b must provide #invalidCodeObject
Claus Gittinger <cg@exept.de>
parents: 2819
diff changeset
  3558
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3559
invalidMessage 
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3560
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3561
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3562
    "this is sent by ST/V code - its the same as #shouldNotImplement"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3563
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3564
    ^ self shouldNotImplement
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3565
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3566
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3567
mustBeRectangle
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3568
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3569
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3570
    "report an argument-not-rectangle-error"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3571
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3572
    ^ self error:'argument must be a Rectangle'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3573
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3574
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3575
mustBeString
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3576
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3577
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3578
    "report an argument-not-string-error"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3579
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3580
    ^ self error:'argument must be a String'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3581
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3582
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3583
notIndexed
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3584
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3585
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3586
    <context: #return>
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3587
1611
f8c9a3ab9929 notIndexedError now uses SubscriptBoundsErrorSignal
Claus Gittinger <cg@exept.de>
parents: 1585
diff changeset
  3588
    "report an error that receiver has no indexed instance variables.
f8c9a3ab9929 notIndexedError now uses SubscriptBoundsErrorSignal
Claus Gittinger <cg@exept.de>
parents: 1585
diff changeset
  3589
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
f8c9a3ab9929 notIndexedError now uses SubscriptBoundsErrorSignal
Claus Gittinger <cg@exept.de>
parents: 1585
diff changeset
  3590
f8c9a3ab9929 notIndexedError now uses SubscriptBoundsErrorSignal
Claus Gittinger <cg@exept.de>
parents: 1585
diff changeset
  3591
    ^ SubscriptOutOfBoundsSignal 
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3592
        raiseErrorString:'receiver has no indexed variables'
1611
f8c9a3ab9929 notIndexedError now uses SubscriptBoundsErrorSignal
Claus Gittinger <cg@exept.de>
parents: 1585
diff changeset
  3593
f8c9a3ab9929 notIndexedError now uses SubscriptBoundsErrorSignal
Claus Gittinger <cg@exept.de>
parents: 1585
diff changeset
  3594
    "Modified: 26.7.1996 / 16:43:13 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3595
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3596
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3597
openDebuggerOnException:ex
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3598
    "{ Pragma: +optSpace }"
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3599
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3600
    "enter the debugger on some unhandled exception"
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3601
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3602
    |msgString debugger|
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3603
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3604
    msgString := ex errorString.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3605
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3606
    "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3607
     if there is no debugger,
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3608
     ask for ignore or exit. Exit will terminate the applciation.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3609
     ignore will raise an abortSignal.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3610
    "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3611
    Debugger isNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3612
        msgString := 'error: ' , msgString.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3613
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3614
        Smalltalk isStandAloneApp ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3615
            Dialog notNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3616
                (Dialog 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3617
                    confirm:msgString 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3618
                    title:(Smalltalk commandName)
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3619
                    yesLabel:'ignore' noLabel:'exit'
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3620
                ) ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3621
                    ^ AbortSignal raise
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3622
                ]
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3623
            ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3624
            msgString errorPrintCR.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3625
            OperatingSystem exit:1
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3626
        ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3627
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3628
        msgString errorPrintCR.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3629
        Smalltalk fatalAbort:'no Debugger defined'
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3630
    ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3631
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3632
    "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3633
     find an appropriate debugger to use
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3634
    "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3635
    debugger := self appropriateDebugger:(thisContext selector).
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3636
    debugger isNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3637
        ^ AbortSignal raise
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3638
    ].    
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3639
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3640
    ^ debugger 
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3641
        enter:ex suspendedContext
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3642
        withMessage:msgString 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3643
        mayProceed:(ex mayProceed).
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3644
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3645
    "Modified: 24.7.1997 / 10:09:20 / cg"
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3646
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3647
!
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  3648
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3649
primitiveFailed
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3650
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3651
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3652
    "report an error that some primitive code failed.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3653
     The error is reported by raising the PrimitiveFailureSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3654
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3655
    ^ PrimitiveFailureSignal raiseRequestWith:nil
4452
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3656
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3657
    "Modified: / 8.5.1996 / 09:14:07 / cg"
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3658
    "Modified: / 26.7.1999 / 10:58:08 / stefan"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3659
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3660
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3661
shouldNotImplement
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3662
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3663
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3664
    "report an error that this message should not be implemented"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3665
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3666
    ^ self error:'method not appropriate for this class'
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3667
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3668
    "Modified: 8.5.1996 / 09:09:44 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3669
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3670
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3671
subclassResponsibility
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3672
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3673
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3674
    "report an error that this message should have been reimplemented in a
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3675
     subclass"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3676
4619
2eb24de5b665 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4603
diff changeset
  3677
    ^ self error:'method must be reimplemented in subclass' mayProceed:true
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3678
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3679
    "Modified: 8.5.1996 / 09:09:26 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3680
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3681
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3682
subscriptBoundsError
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3683
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3684
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3685
    "report an error that some index is out of bounds.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3686
     (when accessing indexable collections).
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3687
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3688
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3689
    ^ SubscriptOutOfBoundsSignal raiseRequestWith:nil
4452
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3690
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3691
    "Modified: / 26.7.1996 / 16:45:42 / cg"
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  3692
    "Modified: / 26.7.1999 / 10:58:27 / stefan"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3693
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3694
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3695
subscriptBoundsError:anIndex
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3696
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3697
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3698
    "report an error that anIndex is out of bounds.
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3699
     (when accessing indexable collections).
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3700
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3701
1021
b0c7f4a235fb show bad index in subscriptBoundsError
Claus Gittinger <cg@exept.de>
parents: 985
diff changeset
  3702
    ^ SubscriptOutOfBoundsSignal 
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3703
        raiseRequestWith:anIndex 
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  3704
        errorString:('subscript (' , anIndex printString , ') out of bounds')
1021
b0c7f4a235fb show bad index in subscriptBoundsError
Claus Gittinger <cg@exept.de>
parents: 985
diff changeset
  3705
1345
2a7936bdc81a commentary
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  3706
    "Modified: 8.5.1996 / 09:14:34 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3707
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3708
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3709
typeCheckError
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3710
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  3711
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3712
    "generated when a variable declared with a type hint gets a bad
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3713
     value assigned"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3714
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3715
    ^ self error:'bad assign of ' , self printString ,
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3716
                  ' (' , self class name , ') to typed variable'
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3717
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3718
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3719
!Object methodsFor:'evaluation'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3720
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3721
value
1327
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3722
    "return the receiver itself.
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3723
     This allows every object to be used where blocks or valueHolders
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3724
     are typically used, and allows for valueHolders and blocks to be
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3725
     used interchangably in some situations.
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3726
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3727
     Time will show, if this is a good idea or leads to sloppy programming
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3728
     style ... (the idea was borrowed from the Self language).
1327
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3729
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3730
     WARNING: dont 'optimize' away ifXXX: blocks 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3731
              (i.e. do NOT replace 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3732
                        foo ifTrue:[var1] ifFalse:[var2]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3733
               by:
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3734
                        foo ifTrue:var1 ifFalse:var2
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3735
              )
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3736
              - the compilers will only generate inline code for the if, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3737
                iff the argument(s) are blocks - otherwise, a true send is
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3738
                generated.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3739
              This 'oprimization' will work semantically correct,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3740
              but execute SLOWER instead."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3741
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3742
    ^ self
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3743
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  3744
    "
1327
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3745
     #(1 2 3 4) indexOf:5 ifAbsent:0     
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3746
     #(1 2 3 4) indexOf:5 ifAbsent:[0]     
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3747
     1 > 2 ifTrue:['yes'] ifFalse:['no']  
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3748
     1 > 2 ifTrue:'yes' ifFalse:'no'       
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3749
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3750
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3751
    "DO NOT DO THIS (its slower)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3752
     (1 > 4) ifTrue:'oops' ifFalse:'ok'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3753
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3754
     USE (the compiler optimizes blocks in if/while):
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3755
     (1 > 4) ifTrue:['oops'] ifFalse:['ok']
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3756
    "
1327
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3757
5dd6b52d8325 comments
Claus Gittinger <cg@exept.de>
parents: 1294
diff changeset
  3758
    "Modified: 3.5.1996 / 11:57:08 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3759
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3760
3330
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3761
!Object methodsFor:'finalization'!
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3762
4257
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3763
disposed
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3764
    "this is invoked for objects which have been registered
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3765
     in a Registry, when the original object dies.
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3766
     Subclasses may redefine this method"
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3767
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3768
    ^ self
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3769
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3770
    "Created: / 4.3.1998 / 10:40:30 / stefan"
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3771
!
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3772
4574
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3773
executor
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3774
    "for VW & Squeak compatibility.
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3775
     Return the object which does the finalization for me."
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3776
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3777
    ^ self shallowCopyForFinalization
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3778
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3779
    "Created: / 5.8.1999 / 14:06:19 / cg"
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3780
!
bcd0132b8d49 going to rename shallowCopyForFinalization to executor
Claus Gittinger <cg@exept.de>
parents: 4558
diff changeset
  3781
3330
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3782
finalize
4257
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3783
    "For ST80 compatibility; ST/X uses #disposed when registered
968bc96fd137 added #disposed to avoid errors in Registry.
Claus Gittinger <cg@exept.de>
parents: 4220
diff changeset
  3784
     objects are finalized. This may change."
3330
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3785
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3786
    ^ self
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3787
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3788
    "Created: / 4.3.1998 / 10:40:30 / stefan"
5408
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3789
!
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3790
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3791
registerForFinalization
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3792
    "register mySelf for later finalization"
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3793
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3794
    FinalizationLobby isNil ifTrue:[
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3795
        FinalizationLobby := Registry new.
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3796
    ].
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3797
    FinalizationLobby register:self
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3798
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3799
!
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3800
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3801
unregisterForFinalization
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3802
    "unregister mySelf for later finalization"
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3803
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3804
    FinalizationLobby notNil ifTrue:[
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3805
        FinalizationLobby unregister:self
5287fd5f6ab0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5402
diff changeset
  3806
    ]
3330
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3807
! !
5e0af0183446 Add dummy #finalize (as in ST80)
Stefan Vogel <sv@exept.de>
parents: 3317
diff changeset
  3808
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3809
!Object methodsFor:'initialization'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3810
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3811
initialize
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3812
    "just to ignore initialize to objects which do not need it"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3813
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3814
    ^ self
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3815
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  3816
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3817
!Object methodsFor:'interest'!
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3818
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3819
addInterest:anInterest
1762
e7267ff590ff Fix misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1751
diff changeset
  3820
    "install an interest forwarder.
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3821
     Here, we use the nonWeakDependencies."
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3822
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3823
    self addNonWeakDependent:anInterest
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3824
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3825
    "Created: 14.10.1996 / 22:27:34 / stefan"
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3826
!
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3827
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3828
expressInterestIn:aspect for:anObject sendBack:aSelector
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3829
    "arrange for aSelector to be sent to anObject whenever the receiver
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3830
     changes aspect."
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3831
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3832
    "/ for now, use an interestConverter, which is somewhat less efficient.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3833
    "/ In the future, a more intelligent DependencyCollection class is planned for
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3834
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3835
    self addInterest:(InterestConverter 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3836
                            destination:anObject 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3837
                            selector:aSelector 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3838
                            aspect:aspect)
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3839
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3840
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3841
     |p b|
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3842
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3843
     b := [Transcript showCR:' -> the point changed'].
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3844
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3845
     p := Point new.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3846
     Transcript showCR:'interest in #foo:'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3847
     p expressInterestIn:#foo for:b sendBack:#value.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3848
     p x:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3849
     Transcript showCR:'now changing #bar ... (expect no notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3850
     p changed:#bar.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3851
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3852
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3853
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3854
     Transcript showCR:'now changing #foo ... (expect notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3855
     p changed:#foo.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3856
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3857
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3858
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3859
     Transcript showCR:'no more interest in #foo:'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3860
     p retractInterestIn:#foo for:b.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3861
     Transcript showCR:'now changing #foo ... (expect no notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3862
     p changed:#foo.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3863
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3864
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3865
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3866
     Transcript showCR:'interest in #bar now:'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3867
     p expressInterestIn:#bar for:b sendBack:#value.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3868
     Transcript showCR:'now changing #foo ... (expect no notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3869
     p changed:#foo.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3870
     Transcript showCR:'now changing #bar ... (expect notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3871
     p changed:#bar.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3872
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3873
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3874
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3875
     Transcript showCR:'interest in #foo now:'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3876
     p expressInterestIn:#foo for:b sendBack:#value.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3877
     Transcript showCR:'now changing #foo ... (expect notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3878
     p changed:#foo.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3879
     Transcript showCR:'now changing #bar ... (expect notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3880
     p changed:#bar.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3881
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3882
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3883
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3884
     Transcript showCR:'no more interests:'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3885
     p retractInterestsFor:b.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3886
     Transcript showCR:'now changing #foo ... (expect no notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3887
     p changed:#foo.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3888
     Transcript showCR:'now changing #bar...  (expect no notification)'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3889
     p changed:#bar.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3890
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3891
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3892
     p release.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3893
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3894
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3895
    "Created: 19.4.1996 / 10:26:22 / cg"
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3896
    "Modified: 19.4.1996 / 12:34:08 / cg"
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3897
    "Modified: 14.10.1996 / 22:28:20 / stefan"
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3898
!
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3899
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3900
interests
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3901
    "return a Collection of interests - empty if there is none.
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3902
     Here, we use the nonWeakDependents for interests."
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3903
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3904
    ^ self nonWeakDependents
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3905
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3906
    "Created: / 14.10.1996 / 22:20:51 / stefan"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3907
    "Modified: / 30.1.1998 / 14:07:35 / cg"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3908
!
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3909
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3910
interestsFor:someOne
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3911
    "return a collection of interests of someOne - empty if there is none."
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3912
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3913
    |coll deps|
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3914
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3915
    deps := self interests.
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3916
    deps size == 0 ifTrue:[^ #()].
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3917
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3918
    coll := IdentitySet new.
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3919
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3920
    deps do:[:dep |
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3921
        (dep isMemberOf:InterestConverter) ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3922
            dep destination == someOne ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3923
                coll add:dep.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3924
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3925
        ]
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3926
    ].
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3927
    ^ coll
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3928
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3929
    "Created: / 30.1.1998 / 14:02:26 / cg"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  3930
    "Modified: / 30.1.1998 / 14:08:24 / cg"
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3931
!
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3932
3960
397537bccf97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3922
diff changeset
  3933
onChangeEvaluate:aBlock
397537bccf97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3922
diff changeset
  3934
    "arrange for aBlock to be evaluated whenever the receiver changes."
397537bccf97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3922
diff changeset
  3935
397537bccf97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3922
diff changeset
  3936
    ^ self onChangeSend:#value to:aBlock
397537bccf97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3922
diff changeset
  3937
397537bccf97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3922
diff changeset
  3938
    "Created: / 29.1.1999 / 16:01:22 / cg"
397537bccf97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3922
diff changeset
  3939
!
397537bccf97 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3922
diff changeset
  3940
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3941
onChangeSend:aSelector to:anObject
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3942
    "arrange for aSelector to be sent to anObject whenever the receiver
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3943
     changes."
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3944
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3945
    "/ for now, use an interestConverter, which is somewhat less efficient.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3946
    "/ In the future, a more intelligent DependencyCollection class is planned for
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3947
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3948
    self addInterest:(InterestConverter 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3949
                          destination:anObject 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  3950
                          selector:aSelector)
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3951
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3952
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3953
     |p b|
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3954
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3955
     b := [Transcript showCR:'the point changed'].
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3956
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3957
     p := Point new.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3958
     p onChangeSend:#value to:b.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3959
     p x:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3960
     Transcript showCR:'now changing'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3961
     p changed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3962
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3963
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3964
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3965
     Transcript showCR:'now changing'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3966
     p changed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3967
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3968
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3969
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3970
     Transcript showCR:'no more interest'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3971
     p retractInterestsFor:b.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3972
     Transcript showCR:'now changing again'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3973
     p changed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3974
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3975
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3976
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3977
     Transcript showCR:'interest again'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3978
     p onChangeSend:#value to:b.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  3979
     Transcript showCR:'now changing again'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3980
     p changed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3981
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3982
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3983
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3984
    "Created: 19.4.1996 / 10:26:38 / cg"
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3985
    "Modified: 19.4.1996 / 12:34:26 / cg"
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3986
    "Modified: 14.10.1996 / 22:28:27 / stefan"
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3987
!
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3988
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3989
removeInterest:anInterest
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3990
    "remove an interest forwarder.
1231
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3991
     Here, we use the nonWeakDependencies."
4f457f654e57 interrests slightly rewritten
Claus Gittinger <cg@exept.de>
parents: 1217
diff changeset
  3992
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3993
    self removeNonWeakDependent:anInterest
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3994
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  3995
    "Created: 14.10.1996 / 22:21:59 / stefan"
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3996
!
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3997
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3998
retractInterestIn:aspect for:someOne
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  3999
    "remove the interest of someOne in the receiver changing aspect
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4000
     (as installed with #expressInterestIn:for:sendBack:)."
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4001
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4002
    "/ for now, remove the interestConverter.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4003
    "/ In the future, a more intelligent DependencyCollection class is planned for
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4004
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4005
    "/ cannot removeDependent within the loop - the collection rehashes
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4006
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4007
    |deps coll|
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4008
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  4009
    deps := self interests.
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4010
    deps size ~~ 0 ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4011
        coll := IdentitySet new.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4012
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4013
        deps do:[:dep |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4014
            (dep isMemberOf:InterestConverter) ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4015
                dep destination == someOne ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4016
                    dep aspect == aspect ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4017
                        self removeInterest:dep.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4018
                        ^ self
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4019
                    ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4020
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4021
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4022
        ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4023
        coll do:[:dep |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4024
            self removeInterest:dep.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4025
        ].
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4026
    ].
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4027
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4028
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4029
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4030
     |p b|
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4031
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4032
     b := [Transcript showCR:'the point changed'].
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4033
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4034
     p := Point new.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4035
     Transcript showCR:'interest in #foo'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4036
     p expressInterestIn:#foo for:b sendBack:#value.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4037
     p x:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4038
     Transcript showCR:'now changing #bar'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4039
     p changed:#bar.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4040
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4041
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4042
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4043
     Transcript showCR:'now changing #foo'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4044
     p changed:#foo.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4045
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4046
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4047
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4048
     Transcript showCR:'no more interest in #foo'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4049
     p retractInterestIn:#foo for:b.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4050
     Transcript showCR:'now changing #foo'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4051
     p changed:#foo.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4052
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4053
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4054
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4055
     Transcript showCR:'interest in #bar now'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4056
     p expressInterestIn:#bar for:b sendBack:#value.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4057
     Transcript showCR:'now changing #foo'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4058
     p changed:#foo.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4059
     Transcript showCR:'now changing #bar'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4060
     p changed:#bar.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4061
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4062
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4063
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4064
     Transcript showCR:'interest in #foo now'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4065
     p expressInterestIn:#foo for:b sendBack:#value.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4066
     Transcript showCR:'now changing #foo'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4067
     p changed:#foo.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4068
     Transcript showCR:'now changing #bar'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4069
     p changed:#bar.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4070
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4071
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4072
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4073
     Transcript showCR:'no more interests'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4074
     p retractInterestsFor:b.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4075
     Transcript showCR:'now changing #foo'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4076
     p changed:#foo.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4077
     Transcript showCR:'now changing #bar'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4078
     p changed:#bar.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4079
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4080
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4081
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4082
    "Created: / 19.4.1996 / 10:27:11 / cg"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4083
    "Modified: / 14.10.1996 / 22:21:19 / stefan"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4084
    "Modified: / 30.1.1998 / 14:05:34 / cg"
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4085
!
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4086
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4087
retractInterestsFor:someOne
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4088
    "remove the interest of someOne in the receiver 
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4089
     (as installed with #onChangeSend:to:)."
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4090
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4091
    "/ for now, remove the interestConverter.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4092
    "/ In the future, a more intelligent DependencyCollection class is planned for
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4093
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4094
    |coll deps|
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4095
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4096
    "/ cannot removeDependent within the loop - the collection rehashes
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4097
1751
0902cadafee2 Rename misspelled "interrest" to "interest".
Stefan Vogel <sv@exept.de>
parents: 1705
diff changeset
  4098
    deps := self interests.
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4099
    deps size ~~ 0 ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4100
        coll := IdentitySet new.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4101
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4102
        deps do:[:dep |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4103
            (dep isMemberOf:InterestConverter) ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4104
                dep destination == someOne ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4105
                    coll add:dep.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4106
                ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4107
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4108
        ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4109
        coll do:[:dep |
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4110
            self removeInterest:dep.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4111
        ].
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4112
    ].
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4113
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4114
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4115
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4116
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4117
     |p b|
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4118
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4119
     b := [Transcript showCR:'the point changed'].
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4120
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4121
     p := Point new.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4122
     p onChangeSend:#value to:b.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4123
     p x:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4124
     Transcript showCR:'now changing'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4125
     p changed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4126
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4127
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4128
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4129
     Transcript showCR:'now changing'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4130
     p changed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4131
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4132
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4133
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4134
     Transcript showCR:'no more interest'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4135
     p retractInterestsFor:b.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4136
     Transcript showCR:'now changing again'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4137
     p changed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4138
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4139
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4140
     Delay waitForSeconds:1.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4141
     Transcript showCR:'interest again'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4142
     p onChangeSend:#value to:b.
1422
9a0b792f2953 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
  4143
     Transcript showCR:'now changing again'.
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4144
     p changed.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4145
     Transcript cr.
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4146
    "
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4147
3254
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4148
    "Created: / 19.4.1996 / 10:23:46 / cg"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4149
    "Modified: / 14.10.1996 / 22:21:25 / stefan"
40b21297d9ab #interests & #weakDependents always return a collection
Claus Gittinger <cg@exept.de>
parents: 3228
diff changeset
  4150
    "Modified: / 30.1.1998 / 14:04:52 / cg"
1217
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4151
! !
4f7099eb007c separated dependencies into weak-ones and nonWeak ones
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
  4152
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4153
!Object methodsFor:'interrupt handling'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4154
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4155
childSignalInterrupt
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4156
    "death of a child process (unix process) - do nothing"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4157
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4158
    ^ self
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4159
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4160
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4161
customInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4162
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4163
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4164
    "a custom interrupt - but no handler has defined"
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4165
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4166
    self error:'custom interrupt' mayProceed:true
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4167
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4168
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4169
errorInterrupt:errorID with:aParameter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4170
    "subsystem error. The arguments errorID and aParameter are the values passed
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4171
     to the 'errorInterruptWithIDAndParameter(id, param)' function, 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4172
     which can be called from C subsystems to raise an (asynchronous)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4173
     error exception.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4174
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4175
     Currently, this is used to map XErrors to smalltalk errors, but can be
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4176
     used from other C subsystems too, to upcast errors.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4177
     Especially, for subsystems which call errorHandler functions asynchronously.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4178
     IDs (currently) used:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4179
        #DisplayError ..... x-error interrupt
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4180
        #XtError      ..... xt-error interrupt (Xt interface is not yet published)
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  4181
    "
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4182
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4183
    |handler|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4184
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4185
    handler := ObjectMemory registeredErrorInterruptHandlers at:errorID ifAbsent:nil.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4186
    handler notNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4187
        "/
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4188
        "/ handler found; let it do whatever it wants ...
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4189
        "/
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4190
        handler errorInterrupt:errorID with:aParameter.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4191
        ^ self
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4192
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4193
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4194
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4195
    "/ no handler - raise errorSignal passing the errorId as parameter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4196
    "/
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4197
    ^ ErrorSignal 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4198
        raiseRequestWith:errorID 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4199
        errorString:('Subsystem error. ErrorID = ' , errorID printString)
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4200
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4201
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4202
exceptionInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4203
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4204
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4205
    "exception interrupt - enter debugger"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4206
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4207
    self error:'exception Interrupt' mayProceed:true
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4208
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4209
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4210
fpExceptionInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4211
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4212
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4213
    "a floating point exception occured - this one
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4214
     has to be handled differently since it comes asynchronous
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4215
     on some machines (for example, on machines with a separate FPU
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4216
     or superscalar architectures. Also, errors from within primitive code
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4217
     (or library functions such as GL) are sent via the Unix-signal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4218
     mechanism this way."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4219
3396
78f572bb3677 pass messageSend as parameter to domainError exception (in fpException)
Claus Gittinger <cg@exept.de>
parents: 3385
diff changeset
  4220
    |where rec|
78f572bb3677 pass messageSend as parameter to domainError exception (in fpException)
Claus Gittinger <cg@exept.de>
parents: 3385
diff changeset
  4221
78f572bb3677 pass messageSend as parameter to domainError exception (in fpException)
Claus Gittinger <cg@exept.de>
parents: 3385
diff changeset
  4222
    where := thisContext sender.
78f572bb3677 pass messageSend as parameter to domainError exception (in fpException)
Claus Gittinger <cg@exept.de>
parents: 3385
diff changeset
  4223
    rec := where receiver.
78f572bb3677 pass messageSend as parameter to domainError exception (in fpException)
Claus Gittinger <cg@exept.de>
parents: 3385
diff changeset
  4224
    rec isNumber ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4225
        ^ rec class
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4226
            raise:#domainErrorSignal
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4227
            receiver:rec
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4228
            selector:where selector
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4229
            arguments:(where args asArray)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4230
            errorString:'floating point exception'
3396
78f572bb3677 pass messageSend as parameter to domainError exception (in fpException)
Claus Gittinger <cg@exept.de>
parents: 3385
diff changeset
  4231
    ].
78f572bb3677 pass messageSend as parameter to domainError exception (in fpException)
Claus Gittinger <cg@exept.de>
parents: 3385
diff changeset
  4232
78f572bb3677 pass messageSend as parameter to domainError exception (in fpException)
Claus Gittinger <cg@exept.de>
parents: 3385
diff changeset
  4233
    "/ could be in some C-library ...
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4234
    ^ Float domainErrorSignal raise
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4235
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4236
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4237
internalError:msg
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4238
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4239
2227
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
  4240
    "this is triggered, when VM hits some bad error,
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4241
     such as corrupted class, corrupted method/selector array
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4242
     etc. The argument string gives some more information on what happened.
2227
eb1e28c62f14 use an extra signal for internal errors
Claus Gittinger <cg@exept.de>
parents: 2209
diff changeset
  4243
     (for example, if you set an objects class to a non-behavior, nil etc.).
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4244
     Its not guaranteed, that the system is in a working condition once
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4245
     this error occurred ...."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4246
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  4247
    InternalErrorSignal raiseWith:self errorString:msg
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4248
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4249
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4250
ioInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4251
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4252
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4253
    "I/O (SIGIO/SIGPOLL) interrupt (supposed to be sent to Processor).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4254
     If we arrive here, there is either no handler (ObjMem>>ioInterruptHandler)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4255
     or it does not understand the ioInterrupt message.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4256
     In any case, this is a sign of some big trouble. Enter debugger."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4257
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4258
    self error:'I/O Interrupt - but no handler' mayProceed:true
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4259
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4260
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4261
memoryInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4262
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4263
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4264
    "out-of-memory interrupt and no handler - enter debugger"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4265
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4266
    self error:'almost out of memory' mayProceed:true
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4267
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4268
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4269
recursionInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4270
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4271
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4272
    "recursion limit (actually: stack overflow) interrupt.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4273
     This interrupt is triggered, when a process stack grows above
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4274
     its stackLimit - usually, this leads into the debugger, but
2689
ada9b102abcf typo fix
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
  4275
     could be caught and the stackLimit increased in the handler.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4276
     At the time we arrive here, the system has still some stack 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4277
     as a reserve so we can continue to do some useful work or cleanup or
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4278
     debugging for a while.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4279
     If the signal is ignored, and the stack continues to grow, there
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4280
     will be a few more chances (and more interrupts) before the VM
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4281
     hard-terminates the process."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4282
5194
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4283
    |con remaining|
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4284
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4285
    (con := thisContext) isRecursive ifFalse:[
4884
988431a226b7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4873
diff changeset
  4286
"/        Processor activeProcess usedStackSize < Processor activeProcess maximumStackSize ifTrue:[
988431a226b7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4873
diff changeset
  4287
"/            "/ mhmh - it hit me, but I am not responsible ...
988431a226b7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4873
diff changeset
  4288
"/            'Stray recursionInterrupt ...' infoPrintCR.
988431a226b7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4873
diff changeset
  4289
"/            ^ self
988431a226b7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4873
diff changeset
  4290
"/        ].
5194
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4291
        'Object [info]: recursionInterrupt from:' printCR.
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4292
        con := con sender.
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4293
        remaining := 50.
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4294
        [con notNil and:[remaining > 0]] whileTrue:[
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4295
            '| ' print. con fullPrint.
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4296
            con := con sender.
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4297
            remaining := remaining - 1
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  4298
        ].
4815
75c3243e523a ignore stray recursion interrupts.
Claus Gittinger <cg@exept.de>
parents: 4808
diff changeset
  4299
        ^ RecursionInterruptSignal raise
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4300
    ]
4815
75c3243e523a ignore stray recursion interrupts.
Claus Gittinger <cg@exept.de>
parents: 4808
diff changeset
  4301
75c3243e523a ignore stray recursion interrupts.
Claus Gittinger <cg@exept.de>
parents: 4808
diff changeset
  4302
    "Modified: / 25.9.1999 / 18:28:11 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4303
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4304
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4305
schedulerInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4306
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4307
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4308
    "scheduler interrupt (supposed to be sent to Processor).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4309
     If we arrive here, either the Processor does not understand it,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4310
     or it has been set to nil. In any case, this is a sign of some
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4311
     big trouble. Enter debugger."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4312
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4313
    self error:'schedulerInterrupt - but no Processor' mayProceed:true
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4314
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4315
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4316
signalInterrupt:signalNumber
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4317
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4318
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4319
    "unix signal occured - some signals are handled as Smalltalk Exceptions 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4320
     (SIGPIPE), others (SIGBUS) are rather fatal ...
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4321
     In any case, IF a smalltalk-signal has been connected to the OS signal,
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4322
     that one is raised.
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4323
     Otherwise, a dialog is shown, asking the user on how to handle the
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4324
     signal.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4325
     TODO: add another argument, giving more detailed signal info (PC, VADDR,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4326
     exact cause etc.). This helps if segvs occur in primitive code.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4327
     Currently (temporary kludge), these are passed as global variables."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4328
2773
c9459bd8400d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2704
diff changeset
  4329
    |box name here sig ignorable titles actions badContext msg pc addr
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4330
     action title|
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4331
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4332
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4333
     special case - since SIGPIPE has an ST-signal associated
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4334
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4335
    (signalNumber == 13) ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4336
        "SIGPIPE - write on a pipe with no one to read"
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4337
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4338
        ^ PipeStream brokenPipeSignal raise.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4339
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4340
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4341
    "if there has been an ST-signal installed, use it ..."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4342
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4343
    sig := OperatingSystem operatingSystemSignal:signalNumber.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4344
    sig notNil ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4345
        ^ sig raise
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4346
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4347
3423
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
  4348
    "/ if handled, raise OSSignalInterruptSignal
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
  4349
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
  4350
    OSSignalInterruptSignal isHandled ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4351
        ^ OSSignalInterruptSignal raiseWith:signalNumber
3423
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
  4352
    ].
b4a43b4f098b new signal: osSignalInterruptSignal;
Claus Gittinger <cg@exept.de>
parents: 3418
diff changeset
  4353
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4354
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4355
     ... otherwise , bring up a box asking for what to do ...
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4356
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4357
    name := OperatingSystem nameForSignal:signalNumber.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4358
    here := thisContext.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4359
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4360
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4361
     the context, in which the signal occurred:
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4362
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4363
    badContext := here sender.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4364
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4365
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4366
     ungrab - in case it happened in a box/popupview
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4367
     otherwise display stays locked
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4368
    "
2851
856557e261a3 ungrab all screens in case of an error
Claus Gittinger <cg@exept.de>
parents: 2829
diff changeset
  4369
"/    Display notNil ifTrue:[
856557e261a3 ungrab all screens in case of an error
Claus Gittinger <cg@exept.de>
parents: 2829
diff changeset
  4370
"/        Display ungrabPointer.
856557e261a3 ungrab all screens in case of an error
Claus Gittinger <cg@exept.de>
parents: 2829
diff changeset
  4371
"/        Display ungrabKeyboard.
856557e261a3 ungrab all screens in case of an error
Claus Gittinger <cg@exept.de>
parents: 2829
diff changeset
  4372
"/    ].
856557e261a3 ungrab all screens in case of an error
Claus Gittinger <cg@exept.de>
parents: 2829
diff changeset
  4373
    Screen notNil ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4374
        Screen allScreens do:[:aScreen |
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4375
            aScreen ungrabPointer.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4376
            aScreen ungrabKeyboard.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4377
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4378
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4379
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4380
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4381
     SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4382
     since the system will retry the faulty instruction, which leads to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4383
     another signal - to avoid frustration, better not offer this option.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4384
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4385
    ignorable := (signalNumber ~~ OperatingSystem sigBUS)
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4386
                  and:[signalNumber ~~ OperatingSystem sigILL
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4387
                  and:[signalNumber ~~ OperatingSystem sigSEGV]].
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4388
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4389
    ignorable ifFalse:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4390
        here isRecursive ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4391
            'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR.
4537
972484195528 minidebugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4535
diff changeset
  4392
            MiniDebugger 
972484195528 minidebugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4535
diff changeset
  4393
                enterWithMessage:'recursive signal' 
972484195528 minidebugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4535
diff changeset
  4394
                mayProceed:true.
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4395
            ^ self
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4396
        ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4397
        "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4398
         a hard signal - go into debugger immediately
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4399
        "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4400
        msg := 'OS-signal: ', name.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4401
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4402
        "/ the IRQ-PC is passed as low-hi, to avoid the need
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4403
        "/ to allocate a LargeInteger in the VM during signal
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4404
        "/ time. I know, this is ugly.
3418
8aafd5280caf construct IRQ-addr using correct shift amounts (alpha)
Claus Gittinger <cg@exept.de>
parents: 3398
diff changeset
  4405
        
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4406
        InterruptPcLow notNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4407
            pc := InterruptPcLow + (InterruptPcHi bitShift:(SmallInteger maxBits + 1 // 2)).
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4408
            pc ~~ 0 ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4409
                msg := msg , ' PC=' , (pc printStringRadix:16)
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4410
            ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4411
        ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4412
        InterruptAddrLow notNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4413
            addr := InterruptAddrLow + (InterruptAddrHi bitShift:(SmallInteger maxBits + 1 // 2)).
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4414
            addr ~~ 0 ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4415
                msg := msg , ' ADDR=' , (addr printStringRadix:16)
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4416
            ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4417
        ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4418
        Debugger enter:here withMessage:msg mayProceed:true. 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4419
        badContext return.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4420
        ^ nil.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4421
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4422
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4423
    OptionBox isNil ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4424
        "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4425
         a system without GUI ...
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4426
         go into minidebugger (if there is one)
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4427
        "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4428
        MiniDebugger isNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4429
            "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4430
             a system without debugging facilities
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4431
             (i.e. a standalone system)
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4432
             output a message and exit.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4433
            "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4434
            ('Object [error]: exit due to Signal ' , name , ' - and no debugger.') errorPrintCR.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4435
            Smalltalk exit.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4436
        ].
4537
972484195528 minidebugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4535
diff changeset
  4437
        MiniDebugger 
972484195528 minidebugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4535
diff changeset
  4438
            enterWithMessage:'Signal caught (' , name, ')' 
972484195528 minidebugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4535
diff changeset
  4439
            mayProceed:true.
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4440
        ^ self
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4441
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4442
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4443
    titles := #('dump core' 'exit ST/X').
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4444
    actions := Array 
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4445
                 with:[Smalltalk fatalAbort]
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4446
                 with:[Smalltalk exit].
2773
c9459bd8400d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2704
diff changeset
  4447
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4448
    action := nil.
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4449
    title := 'OS Signal caught (' , name, ')'.
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4450
    title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs.
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4451
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4452
    "/ if cought while in the scheduler or event dispatcher,
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4453
    "/ a modal dialog is not possible ...
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4454
    "/ (therefore, debug & return make no sense)
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4455
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4456
    Processor activeProcess isSystemProcess ifFalse:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4457
        titles := #('abort' 'debug') , titles.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4458
        actions := (Array
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4459
                        with:[action := #abort]
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4460
                        with:[action := #debug]) , actions.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4461
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4462
        badContext canReturn ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4463
            titles := #('return') , titles.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4464
            actions := (Array with:[action := #return]) , actions.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4465
        ].
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4466
    ].
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4467
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4468
    ignorable ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4469
        titles := titles, #('ignore').
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4470
        actions := actions , (Array with:[action := #ignore]).
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4471
    ].
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4472
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4473
    box := OptionBox 
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4474
                title:title
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4475
                numberOfOptions:actions size.
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4476
    ignorable ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4477
        box defaultButtonIndex:(actions size)
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4478
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4479
    box buttonTitles:titles.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4480
    box actions:actions.
2773
c9459bd8400d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2704
diff changeset
  4481
    box showAtPointer.
c9459bd8400d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2704
diff changeset
  4482
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4483
    action == #return ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4484
        badContext return
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4485
    ].
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4486
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4487
    action == #abort ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4488
        AbortSignal raise.
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4489
    ].
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4490
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4491
    action == #debug ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  4492
        Debugger enter:here withMessage:('Signal ', name) mayProceed:true. 
2774
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4493
    ].
5a7467b9a531 better signalInterrupt dialog
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
  4494
3418
8aafd5280caf construct IRQ-addr using correct shift amounts (alpha)
Claus Gittinger <cg@exept.de>
parents: 3398
diff changeset
  4495
    "Modified: / 4.5.1998 / 20:39:16 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4496
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4497
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4498
spyInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4499
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4500
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4501
    "spy interrupt and no handler - enter debugger"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4502
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4503
    self error:'spy Interrupt - but no handler' mayProceed:true
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4504
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4505
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4506
timerInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4507
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4508
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4509
    "timer interrupt and no handler - enter debugger"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4510
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4520
diff changeset
  4511
    self error:'timer Interrupt - but no handler' mayProceed:true
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4512
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4513
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4514
userInterrupt
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4515
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  4516
1792
ba0dc099895c comment
Claus Gittinger <cg@exept.de>
parents: 1788
diff changeset
  4517
    "user (^c) interrupt.
ba0dc099895c comment
Claus Gittinger <cg@exept.de>
parents: 1788
diff changeset
  4518
     This is typically sent by the VM, when a ctrl-C is typed at the
ba0dc099895c comment
Claus Gittinger <cg@exept.de>
parents: 1788
diff changeset
  4519
     controlling tty (i.e. in the xterm)."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4520
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4521
    UserInterruptSignal raise
1788
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
  4522
!
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
  4523
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
  4524
userInterruptIn:aContext
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
  4525
    "{ Pragma: +optSpace }"
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
  4526
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
  4527
    "user (^c) interrupt - enter debugger, but show aContext
1792
ba0dc099895c comment
Claus Gittinger <cg@exept.de>
parents: 1788
diff changeset
  4528
     as top-context. 
ba0dc099895c comment
Claus Gittinger <cg@exept.de>
parents: 1788
diff changeset
  4529
     This is used to hide any intermediate scheduler contexts, 
ba0dc099895c comment
Claus Gittinger <cg@exept.de>
parents: 1788
diff changeset
  4530
     in case of an interrupted process. Typically, this is sent by
ba0dc099895c comment
Claus Gittinger <cg@exept.de>
parents: 1788
diff changeset
  4531
     the WindowGroup, when a keyboardEvent for the ctrl-C key is
ba0dc099895c comment
Claus Gittinger <cg@exept.de>
parents: 1788
diff changeset
  4532
     processed."
1788
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
  4533
4634
8dd9397431b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4620
diff changeset
  4534
    <context: #return>
8dd9397431b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4620
diff changeset
  4535
4558
94044dccefab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4537
diff changeset
  4536
    UserInterruptSignal raiseRequestWith:nil errorString:nil in:aContext
4452
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  4537
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  4538
    "Created: / 18.10.1996 / 20:46:04 / cg"
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  4539
    "Modified: / 20.10.1996 / 13:06:38 / cg"
3d050f505a0a Raise proceedable signals proceedable.
Stefan Vogel <sv@exept.de>
parents: 4392
diff changeset
  4540
    "Modified: / 26.7.1999 / 10:58:49 / stefan"
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  4541
! !
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  4542
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4543
!Object methodsFor:'message sending'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4544
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4545
perform:aSelector
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4546
    "send the message aSelector to the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4547
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4548
%{
3317
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4549
    REGISTER OBJ sel = aSelector;
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4550
    struct inlineCache *pIlc;
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4551
    static struct inlineCache ilc_0 = __ILCPERF0(@line+14);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4552
    static struct inlineCache ilc_1 = __ILCPERF0(@line+17-1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4553
    static struct inlineCache ilc_2 = __ILCPERF0(@line+20-2);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4554
    static struct inlineCache ilc_3 = __ILCPERF0(@line+23-3);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4555
    static struct inlineCache ilc_4 = __ILCPERF0(@line+26-4);
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4556
    static OBJ last_0 = nil;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4557
    static OBJ last_1 = nil;
3317
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4558
    static OBJ last_2 = nil;
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4559
    static OBJ last_3 = nil;
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4560
    static OBJ last_4 = nil;
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4561
    static flip = 0;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4562
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4563
    if (InterruptPending == nil) {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4564
        if (sel == last_0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4565
            RETURN ( (*(ilc_0.ilc_func))(self, sel, nil, &ilc_0) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4566
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4567
        if (sel == last_1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4568
            RETURN ( (*(ilc_1.ilc_func))(self, sel, nil, &ilc_1) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4569
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4570
        if (sel == last_2) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4571
            RETURN ( (*(ilc_2.ilc_func))(self, sel, nil, &ilc_2) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4572
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4573
        if (sel == last_3) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4574
            RETURN ( (*(ilc_3.ilc_func))(self, sel, nil, &ilc_3) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4575
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4576
        if (sel == last_4) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4577
            RETURN ( (*(ilc_4.ilc_func))(self, sel, nil, &ilc_4) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4578
        }
3317
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4579
        
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4580
        if (flip == 0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4581
            pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4582
            flip = 1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4583
            last_0 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4584
        } else if (flip == 1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4585
            pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4586
            flip = 2;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4587
            last_1 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4588
        } else if (flip == 2) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4589
            pIlc = &ilc_2;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4590
            flip = 3;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4591
            last_2 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4592
        } else if (flip == 3) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4593
            pIlc = &ilc_3;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4594
            flip = 4;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4595
            last_3 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4596
        } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4597
            pIlc = &ilc_4;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4598
            flip = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4599
            last_4 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4600
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4601
        pIlc->ilc_func = __SEND0ADDR__;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4602
        if (pIlc->ilc_poly) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4603
            __flushPolyCache(pIlc->ilc_poly);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4604
            pIlc->ilc_poly = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4605
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4606
        RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) );
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4607
    } else {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4608
        static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4609
        RETURN (_SEND0(self, aSelector, nil, &ilc0));
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  4610
    }
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4611
%}.
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4612
    ^ self perform:aSelector withArguments:#()
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4613
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4614
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4615
perform:aSelector inClass:aClass withArguments:argArray
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4616
    "send the message aSelector with all args taken from argArray 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4617
     to the receiver as a super-send message.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4618
     This is actually more flexible than the normal super-send, since it allows
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4619
     to execute a method in ANY superclass of the receiver (not just the
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4620
     immediate superclass).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4621
     Thus, it is (theoretically) possible to do 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4622
         '5 perform:#< inClass:Magnitude withArguments:#(6)'
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4623
     and evaluate Magnitudes compare method even if there was one in Number.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4624
     This method is used by the interpreter to evaluate super sends
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4625
     and could be used for very special behavior (language extension ?).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4626
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4627
     WARNING: this is an ST/X feature - probably not found in other smalltalks."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4628
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4629
    |numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4630
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4631
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4632
     check, if aClass is really a superclass of the receiver
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4633
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4634
    (self class isSubclassOf:aClass) ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4635
        self error:'class argument is not a superclass of the receiver'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4636
        ^ nil
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4637
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4638
%{
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4639
    REGISTER OBJ *argP;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4640
    int nargs, i;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4641
2895
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  4642
    if (__isArray(argArray)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4643
        nargs = __arraySize(argArray);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4644
        argP = __ArrayInstPtr(argArray)->a_element;
2895
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  4645
    } else {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4646
        if (__isNonNilObject(argArray)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4647
            static struct inlineCache ilcSize = __ILC0(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4648
            numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize); 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4649
            if (!__isSmallInteger(numberOfArgs)) 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4650
                goto bad;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4651
            nargs = __intVal(numberOfArgs);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4652
            argP = (OBJ *)(&a1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4653
            for (i=1; i <= nargs; i++) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4654
                *argP++ = __AT_(argArray, __MKSMALLINT(i));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4655
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4656
            argP = (OBJ *)(&a1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4657
        } else {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4658
            nargs = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4659
        }
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4660
    }
2895
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  4661
    switch (nargs) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4662
        case 0:
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4663
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4664
                static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4665
                RETURN ( _SEND0(self, aSelector, aClass, &ilc0));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4666
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4667
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4668
        case 1: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4669
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4670
                static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4671
                RETURN ( _SEND1(self, aSelector, aClass, &ilc1, argP[0]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4672
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4673
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4674
        case 2: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4675
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4676
                static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4677
                RETURN ( _SEND2(self, aSelector, aClass, &ilc2, argP[0], argP[1]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4678
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4679
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4680
        case 3: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4681
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4682
                static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4683
                RETURN ( _SEND3(self, aSelector, aClass, &ilc3, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4684
                                argP[0], argP[1], argP[2]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4685
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4686
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4687
        case 4: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4688
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4689
                static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4690
                RETURN ( _SEND4(self, aSelector, aClass, &ilc4,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4691
                                argP[0], argP[1], argP[2], argP[3]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4692
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4693
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4694
        case 5: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4695
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4696
                static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4697
                RETURN ( _SEND5(self, aSelector, aClass, &ilc5, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4698
                                argP[0], argP[1], argP[2], argP[3], argP[4]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4699
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4700
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4701
        case 6: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4702
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4703
                static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4704
                RETURN ( _SEND6(self, aSelector, aClass, &ilc6, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4705
                                argP[0], argP[1], argP[2], argP[3], argP[4], argP[5]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4706
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4707
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4708
        case 7: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4709
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4710
                static struct inlineCache ilc7 = __DUMMYILCSELF7(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4711
                RETURN ( _SEND7(self, aSelector, aClass, &ilc7, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4712
                                argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4713
                                argP[6]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4714
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4715
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4716
        case 8: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4717
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4718
                static struct inlineCache ilc8 = __DUMMYILCSELF8(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4719
                RETURN ( _SEND8(self, aSelector, aClass, &ilc8, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4720
                                argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4721
                                argP[6], argP[7]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4722
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4723
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4724
        case 9: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4725
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4726
                static struct inlineCache ilc9 = __DUMMYILCSELF9(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4727
                RETURN ( _SEND9(self, aSelector, aClass, &ilc9, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4728
                                argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4729
                                argP[6], argP[7], argP[8]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4730
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4731
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4732
        case 10: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4733
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4734
                static struct inlineCache ilc10 = __DUMMYILCSELF10(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4735
                RETURN ( _SEND10(self, aSelector, aClass, &ilc10, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4736
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4737
                                 argP[6], argP[7], argP[8], argP[9]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4738
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4739
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4740
        case 11: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4741
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4742
                static struct inlineCache ilc11 = __DUMMYILCSELF11(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4743
                RETURN ( _SEND11(self, aSelector, aClass, &ilc11, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4744
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4745
                                 argP[6], argP[7], argP[8], argP[9], argP[10]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4746
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4747
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4748
        case 12: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4749
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4750
                static struct inlineCache ilc12 = __DUMMYILCSELF12(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4751
                RETURN ( _SEND12(self, aSelector, aClass, &ilc12, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4752
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4753
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4754
                                 argP[11]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4755
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4756
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4757
        case 13: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4758
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4759
                static struct inlineCache ilc13 = __DUMMYILCSELF13(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4760
                RETURN ( _SEND13(self, aSelector, aClass, &ilc13, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4761
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4762
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4763
                                 argP[11], argP[12]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4764
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4765
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4766
        case 14: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4767
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4768
                static struct inlineCache ilc14 = __DUMMYILCSELF14(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4769
                RETURN ( _SEND14(self, aSelector, aClass, &ilc14, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4770
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4771
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4772
                                 argP[11], argP[12], argP[13]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4773
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4774
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4775
        case 15: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4776
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4777
                static struct inlineCache ilc15 = __DUMMYILCSELF15(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4778
                RETURN ( _SEND15(self, aSelector, aClass, &ilc15, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4779
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4780
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4781
                                 argP[11], argP[12], argP[13], argP[14]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4782
            }
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4783
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4784
#ifdef _SEND16
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4785
        case 16:
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4786
            {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4787
                static struct inlineCache ilc16 = __DUMMYILCSELF16(@line+1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4788
                RETURN ( _SEND15(self, aSelector, aClass, &ilc15,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4789
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4790
                                 argP[6], argP[7], argP[8], argP[9], argP[10],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4791
                                 argP[11], argP[12], argP[13], argP[14], argP[15]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  4792
            }
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4793
#endif
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4794
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4795
2895
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  4796
    }
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  4797
bad:;
1626
b3b69b572627 comments
Claus Gittinger <cg@exept.de>
parents: 1624
diff changeset
  4798
%}.
b3b69b572627 comments
Claus Gittinger <cg@exept.de>
parents: 1624
diff changeset
  4799
    "/ arrive here, if bad number of arguments (too many)
b3b69b572627 comments
Claus Gittinger <cg@exept.de>
parents: 1624
diff changeset
  4800
    "/ ST/X (currently) only allows up to 15 method arguments
b3b69b572627 comments
Claus Gittinger <cg@exept.de>
parents: 1624
diff changeset
  4801
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4802
    ^ self primitiveFailed
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4803
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  4804
3317
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4805
perform:aSelector with:arg
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4806
    "send the one-arg-message aSelector to the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4807
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4808
%{
3317
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4809
    REGISTER OBJ sel = aSelector;
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4810
    struct inlineCache *pIlc;
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4811
    static struct inlineCache ilc_0 = __ILCPERF1(@line+14);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4812
    static struct inlineCache ilc_1 = __ILCPERF1(@line+14+3-1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4813
    static struct inlineCache ilc_2 = __ILCPERF1(@line+14+6-2);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4814
    static struct inlineCache ilc_3 = __ILCPERF1(@line+14+9-3);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4815
    static struct inlineCache ilc_4 = __ILCPERF1(@line+14+12-4);
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4816
    static OBJ last_0 = nil;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4817
    static OBJ last_1 = nil;
3317
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4818
    static OBJ last_2 = nil;
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4819
    static OBJ last_3 = nil;
8c0d47236f4b now keep 5 inlineCaches in #perform: and #performWith:
Claus Gittinger <cg@exept.de>
parents: 3309
diff changeset
  4820
    static OBJ last_4 = nil;
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4821
    static flip = 0;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4822
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4823
    if (InterruptPending == nil) {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4824
        if (sel == last_0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4825
            RETURN ( (*(ilc_0.ilc_func))(self, sel, nil, &ilc_0, arg) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4826
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4827
        if (sel == last_1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4828
            RETURN ( (*(ilc_1.ilc_func))(self, sel, nil, &ilc_1, arg) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4829
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4830
        if (sel == last_2) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4831
            RETURN ( (*(ilc_2.ilc_func))(self, sel, nil, &ilc_2, arg) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4832
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4833
        if (sel == last_3) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4834
            RETURN ( (*(ilc_3.ilc_func))(self, sel, nil, &ilc_3, arg) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4835
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4836
        if (sel == last_4) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4837
            RETURN ( (*(ilc_4.ilc_func))(self, sel, nil, &ilc_4, arg) );
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4838
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4839
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4840
        if (flip == 0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4841
            pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4842
            flip = 1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4843
            last_0 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4844
        } else if (flip == 1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4845
            pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4846
            flip = 2;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4847
            last_1 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4848
        } else if (flip == 2) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4849
            pIlc = &ilc_2;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4850
            flip = 3;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4851
            last_2 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4852
        } else if (flip == 3) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4853
            pIlc = &ilc_3;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4854
            flip = 4;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4855
            last_3 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4856
        } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4857
            pIlc = &ilc_4;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4858
            flip = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4859
            last_4 = sel;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4860
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4861
        pIlc->ilc_func = __SEND1ADDR__;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4862
        if (pIlc->ilc_poly) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4863
            __flushPolyCache(pIlc->ilc_poly);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4864
            pIlc->ilc_poly = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4865
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4866
        RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) );
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4867
    } else {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4868
        static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4869
        RETURN (_SEND1(self, aSelector, nil, &ilc1, arg));
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4870
    }
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4871
%}.
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4872
    ^ self perform:aSelector withArguments:(Array with:arg)
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4873
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4874
!
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4875
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4876
perform:aSelector with:arg1 with:arg2
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4877
    "send the two-arg-message aSelector to the receiver"
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4878
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4879
%{
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4880
    struct inlineCache *pIlc;
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4881
    static struct inlineCache ilc_0 = __ILCPERF2(@line+29);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4882
    static struct inlineCache ilc_1 = __ILCPERF2(@line+28);
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4883
    static OBJ last_0 = nil;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4884
    static OBJ last_1 = nil;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4885
    static flip = 0;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4886
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4887
    if (InterruptPending == nil) {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4888
        if (aSelector != last_0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4889
            if (aSelector != last_1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4890
                if (flip) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4891
                    pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4892
                    flip = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4893
                    last_0 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4894
                } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4895
                    pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4896
                    flip = 1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4897
                    last_1 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4898
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4899
                pIlc->ilc_func = __SEND2ADDR__;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4900
                if (pIlc->ilc_poly) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4901
                    __flushPolyCache(pIlc->ilc_poly);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4902
                    pIlc->ilc_poly = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4903
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4904
            } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4905
                pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4906
            }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4907
        } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4908
            pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4909
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4910
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) );
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4911
    } else {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4912
        static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4913
        RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2));
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4914
    }
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4915
%}.
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4916
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2)
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4917
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4918
!
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4919
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4920
perform:aSelector with:arg1 with:arg2 with:arg3
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4921
    "send the three-arg-message aSelector to the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4922
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4923
%{
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4924
    struct inlineCache *pIlc;
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4925
    static struct inlineCache ilc_0 = __ILCPERF3(@line+29);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4926
    static struct inlineCache ilc_1 = __ILCPERF3(@line+28);
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4927
    static OBJ last_0 = nil;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4928
    static OBJ last_1 = nil;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4929
    static flip = 0;
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4930
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4931
    if (InterruptPending == nil) {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4932
        if (aSelector != last_0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4933
            if (aSelector != last_1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4934
                if (flip) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4935
                    pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4936
                    flip = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4937
                    last_0 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4938
                } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4939
                    pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4940
                    flip = 1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4941
                    last_1 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4942
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4943
                pIlc->ilc_func = __SEND3ADDR__;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4944
                if (pIlc->ilc_poly) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4945
                    __flushPolyCache(pIlc->ilc_poly);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4946
                    pIlc->ilc_poly = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4947
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4948
            } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4949
                pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4950
            }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4951
        } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4952
            pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4953
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4954
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4955
                                     arg1, arg2, arg3) );
1533
179ce527e383 added a 2-slot cache to #perform: / #perform:with:* methods.
Claus Gittinger <cg@exept.de>
parents: 1528
diff changeset
  4956
    } else {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4957
        static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4958
        RETURN (_SEND3(self, aSelector, nil, &ilc3, arg1, arg2, arg3));
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  4959
    }
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4960
%}.
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4961
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3)
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  4962
2437
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4963
!
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4964
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4965
perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4966
    "send the four-arg-message aSelector to the receiver"
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4967
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4968
%{
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4969
    struct inlineCache *pIlc;
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4970
    static struct inlineCache ilc_0 = __ILCPERF4(@line+29);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4971
    static struct inlineCache ilc_1 = __ILCPERF4(@line+28);
2437
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4972
    static OBJ last_0 = nil;
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4973
    static OBJ last_1 = nil;
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4974
    static flip = 0;
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  4975
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  4976
    if (InterruptPending == nil) {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4977
        if (aSelector != last_0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4978
            if (aSelector != last_1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4979
                if (flip) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4980
                    pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4981
                    flip = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4982
                    last_0 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4983
                } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4984
                    pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4985
                    flip = 1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4986
                    last_1 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4987
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4988
                pIlc->ilc_func = __SEND4ADDR__;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4989
                if (pIlc->ilc_poly) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4990
                    __flushPolyCache(pIlc->ilc_poly);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4991
                    pIlc->ilc_poly = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4992
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4993
            } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4994
                pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4995
            }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4996
        } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4997
            pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4998
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  4999
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5000
                                     arg1, arg2, arg3, arg4) );
2437
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  5001
    } else {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5002
        static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5003
        RETURN (_SEND4(self, aSelector, nil, &ilc4,
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5004
                       arg1, arg2, arg3, arg4));
2437
63905fb8d89e added perform with 4 args
Claus Gittinger <cg@exept.de>
parents: 2412
diff changeset
  5005
    }
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5006
%}.
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5007
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4)
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5008
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5009
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5010
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5011
perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4 with:arg5
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5012
    "send the five-arg-message aSelector to the receiver"
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5013
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5014
%{
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5015
    struct inlineCache *pIlc;
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5016
    static struct inlineCache ilc_0 = __ILCPERF5(@line+29);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5017
    static struct inlineCache ilc_1 = __ILCPERF5(@line+28);
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5018
    static OBJ last_0 = nil;
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5019
    static OBJ last_1 = nil;
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5020
    static flip = 0;
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5021
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5022
    if (InterruptPending == nil) {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5023
        if (aSelector != last_0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5024
            if (aSelector != last_1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5025
                if (flip) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5026
                    pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5027
                    flip = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5028
                    last_0 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5029
                } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5030
                    pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5031
                    flip = 1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5032
                    last_1 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5033
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5034
                pIlc->ilc_func = __SEND5ADDR__;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5035
                if (pIlc->ilc_poly) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5036
                    __flushPolyCache(pIlc->ilc_poly);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5037
                    pIlc->ilc_poly = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5038
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5039
            } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5040
                pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5041
            }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5042
        } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5043
            pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5044
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5045
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5046
                                     arg1, arg2, arg3, arg4, arg5) );
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5047
    } else {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5048
        static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5049
        RETURN (_SEND5(self, aSelector, nil, &ilc5,
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5050
                       arg1, arg2, arg3, arg4, arg5));
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5051
    }
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5052
%}.
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5053
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5054
                                                  with:arg5)
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5055
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5056
!
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5057
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5058
perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4 with:arg5 with:arg6
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5059
    "send the six-arg-message aSelector to the receiver"
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5060
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5061
%{
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5062
    struct inlineCache *pIlc;
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5063
    static struct inlineCache ilc_0 = __ILCPERF6(@line+29);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5064
    static struct inlineCache ilc_1 = __ILCPERF6(@line+28);
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5065
    static OBJ last_0 = nil;
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5066
    static OBJ last_1 = nil;
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5067
    static flip = 0;
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5068
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5069
    if (InterruptPending == nil) {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5070
        if (aSelector != last_0) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5071
            if (aSelector != last_1) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5072
                if (flip) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5073
                    pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5074
                    flip = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5075
                    last_0 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5076
                } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5077
                    pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5078
                    flip = 1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5079
                    last_1 = aSelector;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5080
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5081
                pIlc->ilc_func = __SEND6ADDR__;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5082
                if (pIlc->ilc_poly) {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5083
                    __flushPolyCache(pIlc->ilc_poly);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5084
                    pIlc->ilc_poly = 0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5085
                }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5086
            } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5087
                pIlc = &ilc_1;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5088
            }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5089
        } else {
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5090
            pIlc = &ilc_0;
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5091
        }
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5092
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5093
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5094
                                     arg1, arg2, arg3, arg4, arg5, arg6) );
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5095
    } else {
4090
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5096
        static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5097
        RETURN (_SEND6(self, aSelector, nil, &ilc6,
ada783cc6b37 line numbers in primitive-perform.
Claus Gittinger <cg@exept.de>
parents: 4053
diff changeset
  5098
                       arg1, arg2, arg3, arg4, arg5, arg6));
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5099
    }
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5100
%}.
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5101
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5102
                                                  with:arg5 with:arg6)
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  5103
3177
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5104
!
a94f43a8304c added #perform: with 5 & 6 args
Claus Gittinger <cg@exept.de>
parents: 3175
diff changeset
  5105
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5106
perform:aSelector withArguments:argArray
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5107
    "send the message aSelector with all args taken from argArray 
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  5108
     to the receiver."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5109
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  5110
    |numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5111
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5112
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5113
    REGISTER OBJ *argP;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5114
    int nargs, i;
3306
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5115
    static struct inlineCache ilcSize = __ILC0(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5116
    static OBJ last0 = nil; static struct inlineCache ilc0 = __ILCPERF0(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5117
    static OBJ last1 = nil; static struct inlineCache ilc1 = __ILCPERF1(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5118
    static OBJ last2 = nil; static struct inlineCache ilc2 = __ILCPERF2(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5119
    static OBJ last3 = nil; static struct inlineCache ilc3 = __ILCPERF3(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5120
    static OBJ last4 = nil; static struct inlineCache ilc4 = __ILCPERF4(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5121
    static OBJ last5 = nil; static struct inlineCache ilc5 = __ILCPERF5(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5122
    static OBJ last6 = nil; static struct inlineCache ilc6 = __ILCPERF6(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5123
    static OBJ last7 = nil; static struct inlineCache ilc7 = __ILCPERF7(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5124
    static OBJ last8 = nil; static struct inlineCache ilc8 = __ILCPERF8(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5125
    static OBJ last9 = nil; static struct inlineCache ilc9 = __ILCPERF9(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5126
    static OBJ last10 = nil; static struct inlineCache ilc10 = __ILCPERF10(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5127
    static OBJ last11 = nil; static struct inlineCache ilc11 = __ILCPERF11(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5128
    static OBJ last12 = nil; static struct inlineCache ilc12 = __ILCPERF12(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5129
    static OBJ last13 = nil; static struct inlineCache ilc13 = __ILCPERF13(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5130
    static OBJ last14 = nil; static struct inlineCache ilc14 = __ILCPERF14(@line);
66c9ab533baa care for interruptPending in #perform-methods.
Claus Gittinger <cg@exept.de>
parents: 3268
diff changeset
  5131
    static OBJ last15 = nil; static struct inlineCache ilc15 = __ILCPERF15(@line);
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5132
    OBJ l;
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5133
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5134
#if defined(xxxTHIS_CONTEXT) /* not because this has a context */
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5135
    /*
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  5136
     * must set lineno in sender by hand here ... (because of NOCONTEXT)
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5137
     */
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5138
    if ((l = __ILC_LNO_AS_OBJ(__pilc)) != __MKSMALLINT(0)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5139
        _ContextInstPtr(__thisContext)->c_lineno = l;
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5140
    }
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5141
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5142
2895
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  5143
    if (__isArray(argArray)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5144
        nargs = __arraySize(argArray);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5145
        argP = __ArrayInstPtr(argArray)->a_element;
2895
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  5146
    } else {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5147
        if (__isNonNilObject(argArray)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5148
            numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize); 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5149
            if (!__isSmallInteger(numberOfArgs)) 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5150
                goto bad;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5151
            nargs = __intVal(numberOfArgs);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5152
            argP = (OBJ *)(&a1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5153
            for (i=1; i <= nargs; i++) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5154
                *argP++ = __AT_(argArray, __MKSMALLINT(i));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5155
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5156
            argP = (OBJ *)(&a1);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5157
        } else {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5158
            nargs = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5159
        }
2895
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  5160
    }
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  5161
    switch (nargs) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5162
        case 0:
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5163
            if ((InterruptPending != nil) || (aSelector != last0)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5164
                ilc0.ilc_func = __SEND0ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5165
                if (ilc0.ilc_poly) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5166
                    __flushPolyCache(ilc0.ilc_poly);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5167
                    ilc0.ilc_poly = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5168
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5169
                last0 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5170
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5171
#ifdef xxTHIS_CONTEXT  /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5172
            ilc0.ilc_lineNo = __pilc->ilc_lineNo;
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  5173
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5174
            RETURN ((*ilc0.ilc_func)(self, aSelector, nil, &ilc0));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5175
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5176
        case 1: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5177
            if ((InterruptPending != nil) || (aSelector != last1)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5178
                ilc1.ilc_func = __SEND1ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5179
                if (ilc1.ilc_poly) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5180
                    __flushPolyCache(ilc1.ilc_poly);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5181
                    ilc1.ilc_poly = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5182
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5183
                last1 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5184
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5185
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5186
            ilc1.ilc_lineNo = __pilc->ilc_lineNo;
44
b262907c93ea *** empty log message ***
claus
parents: 39
diff changeset
  5187
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5188
            RETURN ( (*ilc1.ilc_func)(self, aSelector, nil, &ilc1, argP[0]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5189
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5190
        case 2: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5191
            if ((InterruptPending != nil) || (aSelector != last2)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5192
                ilc2.ilc_func = __SEND2ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5193
                if (ilc2.ilc_poly) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5194
                    __flushPolyCache(ilc2.ilc_poly);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5195
                    ilc2.ilc_poly = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5196
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5197
                last2 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5198
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5199
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5200
            ilc2.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5201
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5202
            RETURN ( (*ilc2.ilc_func)(self, aSelector, nil, &ilc2, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5203
                                            argP[0], argP[1]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5204
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5205
        case 3: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5206
            if ((InterruptPending != nil) || (aSelector != last3)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5207
                ilc3.ilc_func = __SEND3ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5208
                if (ilc3.ilc_poly) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5209
                    __flushPolyCache(ilc3.ilc_poly);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5210
                    ilc3.ilc_poly = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5211
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5212
                last3 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5213
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5214
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5215
            ilc3.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5216
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5217
            RETURN ( (*ilc3.ilc_func)(self, aSelector, nil, &ilc3, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5218
                                            argP[0], argP[1], argP[2]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5219
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5220
        case 4: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5221
            if ((InterruptPending != nil) || (aSelector != last4)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5222
                ilc4.ilc_func = __SEND4ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5223
                if (ilc4.ilc_poly) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5224
                    __flushPolyCache(ilc4.ilc_poly);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5225
                    ilc4.ilc_poly = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5226
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5227
                last4 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5228
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5229
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5230
            ilc4.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5231
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5232
            RETURN ( (*ilc4.ilc_func)(self, aSelector, nil, &ilc4,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5233
                                            argP[0], argP[1], argP[2], argP[3]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5234
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5235
        case 5: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5236
            if ((InterruptPending != nil) || (aSelector != last5)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5237
                ilc5.ilc_func = __SEND5ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5238
                if (ilc5.ilc_poly) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5239
                    __flushPolyCache(ilc5.ilc_poly);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5240
                    ilc5.ilc_poly = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5241
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5242
                last5 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5243
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5244
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5245
            ilc5.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5246
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5247
            RETURN ( (*ilc5.ilc_func)(self, aSelector, nil, &ilc5, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5248
                                            argP[0], argP[1], argP[2], argP[3], argP[4]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5249
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5250
        case 6: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5251
            if ((InterruptPending != nil) || (aSelector != last6)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5252
                ilc6.ilc_func = __SEND6ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5253
                if (ilc6.ilc_poly) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5254
                    __flushPolyCache(ilc6.ilc_poly);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5255
                    ilc6.ilc_poly = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5256
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5257
                last6 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5258
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5259
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5260
            ilc6.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5261
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5262
            RETURN ( (*ilc6.ilc_func)(self, aSelector, nil, &ilc6, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5263
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5264
                                            argP[5]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5265
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5266
        case 7: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5267
            if ((InterruptPending != nil) || (aSelector != last7)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5268
                ilc7.ilc_func = __SEND7ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5269
                if (ilc7.ilc_poly) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5270
                    __flushPolyCache(ilc7.ilc_poly);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5271
                    ilc7.ilc_poly = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5272
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5273
                last7 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5274
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5275
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5276
            ilc7.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5277
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5278
            RETURN ( (*ilc7.ilc_func)(self, aSelector, nil, &ilc7, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5279
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5280
                                            argP[5], argP[6]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5281
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5282
        case 8:
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5283
            if ((InterruptPending != nil) || (aSelector != last8)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5284
                ilc8.ilc_func = __SEND8ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5285
                last8 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5286
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5287
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5288
            ilc8.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5289
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5290
            RETURN ( (*ilc8.ilc_func)(self, aSelector, nil, &ilc8, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5291
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5292
                                            argP[5], argP[6], argP[7]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5293
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5294
        case 9: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5295
            if ((InterruptPending != nil) || (aSelector != last9)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5296
                ilc9.ilc_func = __SEND9ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5297
                last9 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5298
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5299
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5300
            ilc9.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5301
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5302
            RETURN ( (*ilc9.ilc_func)(self, aSelector, nil, &ilc9, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5303
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5304
                                            argP[5], argP[6], argP[7], argP[8]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5305
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5306
        case 10: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5307
            if ((InterruptPending != nil) || (aSelector != last10)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5308
                ilc10.ilc_func = __SEND10ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5309
                last10 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5310
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5311
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5312
            ilc10.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5313
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5314
            RETURN ( (*ilc10.ilc_func)(self, aSelector, nil, &ilc10, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5315
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5316
                                            argP[5], argP[6], argP[7], argP[8], argP[9]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5317
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5318
        case 11: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5319
            if ((InterruptPending != nil) || (aSelector != last11)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5320
                ilc11.ilc_func = __SEND11ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5321
                last11 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5322
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5323
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5324
            ilc11.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5325
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5326
            RETURN ( (*ilc11.ilc_func)(self, aSelector, nil, &ilc11, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5327
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5328
                                            argP[5], argP[6], argP[7], argP[8], argP[9],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5329
                                            argP[10]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5330
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5331
        case 12: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5332
            if ((InterruptPending != nil) || (aSelector != last12)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5333
                ilc12.ilc_func = __SEND12ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5334
                last12 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5335
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5336
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5337
            ilc12.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5338
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5339
            RETURN ( (*ilc12.ilc_func)(self, aSelector, nil, &ilc12, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5340
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5341
                                            argP[5], argP[6], argP[7], argP[8], argP[9],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5342
                                            argP[10], argP[11]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5343
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5344
        case 13: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5345
            if ((InterruptPending != nil) || (aSelector != last13)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5346
                ilc13.ilc_func = __SEND13ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5347
                last13 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5348
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5349
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5350
            ilc13.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5351
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5352
            RETURN ( (*ilc13.ilc_func)(self, aSelector, nil, &ilc13, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5353
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5354
                                            argP[5], argP[6], argP[7], argP[8], argP[9],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5355
                                            argP[10], argP[11], argP[12]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5357
        case 14: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5358
            if ((InterruptPending != nil) || (aSelector != last14)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5359
                ilc14.ilc_func = __SEND14ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5360
                last14 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5361
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5362
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5363
            ilc14.ilc_lineNo = __pilc->ilc_lineNo;
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5364
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5365
            RETURN ( (*ilc14.ilc_func)(self, aSelector, nil, &ilc14, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5366
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5367
                                            argP[5], argP[6], argP[7], argP[8], argP[9],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5368
                                            argP[10], argP[11], argP[12], argP[13]));
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5369
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5370
        case 15: 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5371
            if ((InterruptPending != nil) || (aSelector != last15)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5372
                ilc15.ilc_func = __SEND15ADDR__;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5373
                last15 = aSelector;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5374
            }
1085
3f5ae1995e83 fixed lineNumber info with #perform (that used to work !)
Claus Gittinger <cg@exept.de>
parents: 1078
diff changeset
  5375
#ifdef xxTHIS_CONTEXT /* not because this has a context */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5376
            ilc15.ilc_lineNo = __pilc->ilc_lineNo;
77
6c38ca59927f *** empty log message ***
claus
parents: 71
diff changeset
  5377
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5378
            RETURN ( (*ilc15.ilc_func)(self, aSelector, nil, &ilc15, 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5379
                                            argP[0], argP[1], argP[2], argP[3], argP[4],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5380
                                            argP[5], argP[6], argP[7], argP[8], argP[9],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5381
                                            argP[10], argP[11], argP[12], argP[13],
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5382
                                            argP[14]));
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5383
    }
2895
41fbba8eb543 Fix #perform:withArguments for non-array arguments collections.
Stefan Vogel <sv@exept.de>
parents: 2893
diff changeset
  5384
bad:;
1626
b3b69b572627 comments
Claus Gittinger <cg@exept.de>
parents: 1624
diff changeset
  5385
%}.
b3b69b572627 comments
Claus Gittinger <cg@exept.de>
parents: 1624
diff changeset
  5386
    "/ arrive here, if bad number of arguments (too many)
b3b69b572627 comments
Claus Gittinger <cg@exept.de>
parents: 1624
diff changeset
  5387
    "/ ST/X (currently) only allows up to 15 method arguments
b3b69b572627 comments
Claus Gittinger <cg@exept.de>
parents: 1624
diff changeset
  5388
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5389
    ^ self primitiveFailed
2819
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5390
!
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5391
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5392
performMethod:aMethod
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5393
    "invoke aMethod on the receiver.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5394
     The method should be a zero-argument method.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5395
     This is a non-object-oriented entry, applying a method
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5396
     in a functional way on a receiver.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5397
     Warning:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5398
         Take care for the method to be appropriate for the
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5399
         receiver - no checking is done by the VM."
2819
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5400
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5401
    ^ aMethod valueWithReceiver:self arguments:#()
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5402
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5403
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5404
     |mthd|
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5405
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5406
     mthd := SmallInteger compiledMethodAt:#negated.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5407
     Transcript showCR:(1 performMethod:mthd)
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5408
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5409
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5410
    "BAD USE example:
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5411
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5412
     |mthd|
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5413
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5414
     mthd := Point compiledMethodAt:#x.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5415
     Transcript showCR:((1->2) performMethod:mthd)
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5416
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5417
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5418
    "Modified: 31.7.1997 / 17:41:50 / cg"
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5419
!
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5420
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5421
performMethod:aMethod arguments:argumentArray
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5422
    "invoke aMethod on the receiver, passing an argumentArray.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5423
     The size of the argumentArray should match the number of args
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5424
     expected by the method.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5425
     This is a non-object-oriented entry, applying a method
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5426
     in a functional way on a receiver.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5427
     Warning:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5428
         Take care for the method to be appropriate for the
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5429
         receiver - no checking is done by the VM."
2819
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5430
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5431
    ^ aMethod valueWithReceiver:self arguments:argumentArray
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5432
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5433
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5434
     |mthd|
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5435
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5436
     mthd := SmallInteger compiledMethodAt:#+.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5437
     Transcript showCR:(1 performMethod:mthd arguments:#(2))
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5438
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5439
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5440
    "Created: 31.7.1997 / 17:46:31 / cg"
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5441
!
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5442
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5443
performMethod:aMethod with:arg
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5444
    "invoke aMethod on the receiver, passing an argument.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5445
     The method should be a one-argument method.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5446
     This is a non-object-oriented entry, applying a method
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5447
     in a functional way on a receiver.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5448
     Warning:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5449
         Take care for the method to be appropriate for the
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5450
         receiver - no checking is done by the VM."
2819
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5451
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5452
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg)
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5453
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5454
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5455
     |mthd|
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5456
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5457
     mthd := SmallInteger compiledMethodAt:#+.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5458
     Transcript showCR:(1 performMethod:mthd with:2)
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5459
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5460
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5461
    "Modified: 31.7.1997 / 17:42:32 / cg"
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5462
!
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5463
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5464
performMethod:aMethod with:arg1 with:arg2
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5465
    "invoke aMethod on the receiver, passing two arguments.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5466
     The method should be a two-argument method.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5467
     This is a non-object-oriented entry, applying a method
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5468
     in a functional way on a receiver.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5469
     Warning:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5470
         Take care for the method to be appropriate for the
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5471
         receiver - no checking is done by the VM."
2819
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5472
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5473
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2)
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5474
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5475
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5476
     |mthd arr|
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5477
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5478
     arr := Array new:1.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5479
     mthd := Array compiledMethodAt:#basicAt:put:.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5480
     arr performMethod:mthd with:1 with:'foo'.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5481
     Transcript showCR:arr
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5482
    "
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5483
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5484
    "Modified: 31.7.1997 / 17:44:54 / cg"
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5485
!
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5486
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5487
performMethod:aMethod with:arg1 with:arg2 with:arg3
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5488
    "invoke aMethod on the receiver, passing three arguments.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5489
     The method should be a three-argument method.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5490
     This is a non-object-oriented entry, applying a method
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5491
     in a functional way on a receiver.
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5492
     Warning:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5493
         Take care for the method to be appropriate for the
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5494
         receiver - no checking is done by the VM."
2819
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5495
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5496
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2 with:arg3)
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5497
18316ec20169 added #performMethod: protocol for VW compatibility.
Claus Gittinger <cg@exept.de>
parents: 2818
diff changeset
  5498
    "Created: 31.7.1997 / 17:45:20 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5499
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5500
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5501
!Object methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5502
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5503
className
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5504
    "return the classname of the receivers class"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5505
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5506
    ^ self class name
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5507
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5508
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5509
     1 className
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5510
     1 class className   'this may change ...'
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5511
     $a className
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5512
     $a class className  'this may change ...'
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5513
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5514
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5515
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5516
classNameWithArticle
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5517
    "return a string consisting of classname preceeded by an article.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5518
     (dont expect me to write national variants for this ... :-)
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5519
     If you have special preferences, redefine it ..."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5520
1391
c2e4f3ee163c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1386
diff changeset
  5521
    |classname cls|
c2e4f3ee163c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1386
diff changeset
  5522
c2e4f3ee163c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1386
diff changeset
  5523
    (cls := self class) == self ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5524
        ^ 'a funny object'
1391
c2e4f3ee163c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1386
diff changeset
  5525
    ].
c2e4f3ee163c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1386
diff changeset
  5526
    classname := cls displayString.
85
claus
parents: 77
diff changeset
  5527
    ^ classname article , ' ' , classname
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5528
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5529
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5530
     1 classNameWithArticle
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5531
     (1->2) classNameWithArticle
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5532
     XWorkstation basicNew classNameWithArticle
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5533
    "
1391
c2e4f3ee163c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1386
diff changeset
  5534
c2e4f3ee163c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1386
diff changeset
  5535
    "Modified: 13.5.1996 / 12:16:14 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5536
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5537
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5538
errorPrint
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5539
    "print the receiver on the standard error stream."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5540
1089
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5541
    Stream streamErrorSignal catch:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5542
        self printOn:Stderr
1089
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5543
    ]
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5544
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5545
    "Modified: 7.3.1996 / 19:11:29 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5546
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5547
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5548
errorPrintCR
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  5549
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  5550
1089
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5551
    "print the receiver followed by a cr on the standard error stream."
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5552
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5553
    Stream streamErrorSignal catch:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5554
        self printOn:Stderr.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5555
        Stderr cr
1089
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5556
    ]
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5557
6df9414b354f catch errors while errorPrinting (happened when controlling xterm was closed)
Claus Gittinger <cg@exept.de>
parents: 1085
diff changeset
  5558
    "Modified: 7.3.1996 / 19:13:01 / cg"
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5559
    "Created: 20.5.1996 / 10:20:41 / cg"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5560
!
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5561
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5562
errorPrintNL
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5563
    "{ Pragma: +optSpace }"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5564
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5565
    "print the receiver followed by a cr on the standard error stream.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5566
     Please use #errorPrintCR - this method exists for backward compatibility."
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5567
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5568
    ^ self errorPrintCR
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5569
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5570
    "Modified: 20.5.1996 / 10:24:45 / cg"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5571
!
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5572
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5573
errorPrintNewline
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5574
    "{ Pragma: +optSpace }"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5575
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5576
    "print the receiver followed by a cr on the standard error stream.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5577
     Please use #errorPrintCR - this method exists for backward compatibility."
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5578
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5579
    self errorPrintCR.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5580
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5581
    "Modified: 20.5.1996 / 10:24:38 / cg"
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5582
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5583
356
claus
parents: 348
diff changeset
  5584
infoPrint
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  5585
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  5586
356
claus
parents: 348
diff changeset
  5587
    "print the receiver on the standard error stream.
claus
parents: 348
diff changeset
  5588
     This is meant for information messages which are not warnings
claus
parents: 348
diff changeset
  5589
     or fatal messages.
claus
parents: 348
diff changeset
  5590
     These messages can be turned on/off by 'Object infoPrinting:true/false'"
claus
parents: 348
diff changeset
  5591
2114
706cf3f9019a initialize InfoPrinting flag from VM's setting
Claus Gittinger <cg@exept.de>
parents: 2096
diff changeset
  5592
    InfoPrinting == true ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5593
        self errorPrint
356
claus
parents: 348
diff changeset
  5594
    ]
claus
parents: 348
diff changeset
  5595
!
claus
parents: 348
diff changeset
  5596
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5597
infoPrintCR
1119
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  5598
    "{ Pragma: +optSpace }"
956d62a5656c compile seldom used methods with optSpace (is this a good idea ?)
Claus Gittinger <cg@exept.de>
parents: 1109
diff changeset
  5599
356
claus
parents: 348
diff changeset
  5600
    "print the receiver followed by a cr on the standard error stream.
claus
parents: 348
diff changeset
  5601
     This is meant for information messages which are not warnings
claus
parents: 348
diff changeset
  5602
     or fatal messages.
claus
parents: 348
diff changeset
  5603
     These messages can be turned on/off by 'Object infoPrinting:true/false'"
claus
parents: 348
diff changeset
  5604
2114
706cf3f9019a initialize InfoPrinting flag from VM's setting
Claus Gittinger <cg@exept.de>
parents: 2096
diff changeset
  5605
    InfoPrinting == true ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5606
        self errorPrintCR
356
claus
parents: 348
diff changeset
  5607
    ]
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5608
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5609
    "Created: 20.5.1996 / 10:21:28 / cg"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5610
!
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5611
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5612
infoPrintNL
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5613
    "{ Pragma: +optSpace }"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5614
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5615
    "print the receiver followed by a cr on the standard error stream.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5616
     This is meant for information messages which are not warnings
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5617
     or fatal messages.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5618
     These messages can be turned on/off by 'Object infoPrinting:true/false'.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5619
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5620
     Please use #infoPrintCR - this method exists for backward compatibility."
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5621
2114
706cf3f9019a initialize InfoPrinting flag from VM's setting
Claus Gittinger <cg@exept.de>
parents: 2096
diff changeset
  5622
    ^ self infoPrintCR
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5623
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5624
    "Modified: 20.5.1996 / 10:25:07 / cg"
356
claus
parents: 348
diff changeset
  5625
!
claus
parents: 348
diff changeset
  5626
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5627
print
1887
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  5628
    "print the receiver on the standard output stream (which is not the Transcript)"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5629
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5630
    self printOn:Stdout
1887
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  5631
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  5632
    "Modified: 4.11.1996 / 23:36:58 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5633
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5634
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5635
printCR
1887
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  5636
    "print the receiver followed by a cr on the standard output stream (which is not the Transcript)"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5637
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5638
    self printOn:Stdout.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5639
    Stdout cr
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5640
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5641
    "Created: 20.5.1996 / 10:21:37 / cg"
1887
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  5642
    "Modified: 4.11.1996 / 23:37:06 / cg"
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5643
!
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5644
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5645
printNL
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5646
    "print the receiver followed by a cr on the standard output stream
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5647
     This exists for GNU Smalltalk compatibility - please use #printCR."
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5648
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5649
    ^ self printCR
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5650
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5651
    "Modified: 20.5.1996 / 10:25:31 / cg"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5652
!
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5653
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5654
printNewline
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5655
    "print the receiver followed by a cr on the standard output stream.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5656
     This exists for backward compatibility - please use #printCR."
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5657
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5658
    self printCR
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5659
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5660
    "Modified: 20.5.1996 / 10:25:46 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5661
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5662
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5663
printOn:aStream
4392
26fb48f04e1b comment
Claus Gittinger <cg@exept.de>
parents: 4363
diff changeset
  5664
    "append a user printed representation of the receiver to aStream.
26fb48f04e1b comment
Claus Gittinger <cg@exept.de>
parents: 4363
diff changeset
  5665
     The format is suitable for a human - not meant to be read back.
26fb48f04e1b comment
Claus Gittinger <cg@exept.de>
parents: 4363
diff changeset
  5666
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5667
     The default here is to output the receivers class name.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5668
     BUT: this method is heavily redefined for objects which
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5669
     can print prettier."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5670
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5671
    aStream nextPutAll:self classNameWithArticle
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5672
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5673
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5674
printOn:aStream leftPaddedTo:size
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5675
    "print the receiver on aStream, padding with spaces up to size.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5676
     padding is done on the left."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5677
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5678
    self printOn:aStream leftPaddedTo:size with:(Character space)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5679
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5680
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5681
     123 printOn:Transcript leftPaddedTo:10. Transcript cr
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5682
     123 printOn:Transcript leftPaddedTo:2. Transcript cr
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5683
    "
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5684
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5685
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5686
printOn:aStream leftPaddedTo:size with:padCharacter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5687
    "print the receiver on aStream, padding with padCharacters up to size.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5688
     padding is done on the left."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5689
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5690
    aStream nextPutAll:(self printStringLeftPaddedTo:size with:padCharacter)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5691
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5692
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5693
     123 printOn:Transcript leftPaddedTo:10 with:$_ . Transcript cr
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5694
     123 printOn:Transcript leftPaddedTo:10 with:$. . Transcript cr
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5695
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5696
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5697
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5698
printOn:aStream paddedTo:size
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5699
    "print the receiver on aStream, padding with spaces up to size."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5700
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5701
    self printOn:aStream paddedTo:size with:(Character space)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5702
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5703
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5704
     123.0 printOn:Transcript paddedTo:10. Transcript nextPut:$|. Transcript cr
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5705
    "
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5706
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5707
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5708
printOn:aStream paddedTo:size with:padCharacter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5709
    "print the receiver on aStream, padding with padCharacter up to size"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5710
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5711
    aStream nextPutAll:(self printStringPaddedTo:size with:padCharacter).
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5712
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5713
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5714
     123 printOn:Transcript paddedTo:10 with:$_ . Transcript cr
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5715
     123 printOn:Transcript paddedTo:10 with:$. . Transcript cr
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5716
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5717
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5718
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5719
printOn:aStream zeroPaddedTo:size
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5720
    "print the receiver on aStream, padding with zeros up to size.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5721
     Usually used with float numbers."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5722
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5723
    self printOn:aStream paddedTo:size with:$0.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5724
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5725
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5726
     123.0 printOn:Transcript zeroPaddedTo:10
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5727
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5728
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5729
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5730
printRightAdjustLen:size
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5731
    "obsolete - just a name confusion.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5732
     This method will go away ..."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5733
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5734
    (self printStringLeftPaddedTo:size) printOn:Stdout
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5735
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5736
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5737
printString
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5738
    "return a string for printing the receiver.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5739
     Since we now use printOn: as the basic print mechanism,
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5740
     we have to create a stream and print into it."
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5741
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5742
    |s|
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5743
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5744
    s := WriteStream on:(String new:30).
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5745
    self printOn:s.
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5746
    ^ s contents
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5747
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5748
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5749
printStringLeftPaddedTo:size
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5750
    "return my printString as a right-adjusted string of length size;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5751
     characters on the left are filled with spaces.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5752
     If the printString is longer than size, 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5753
     it is returned unchanged (i.e. not truncated)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5754
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5755
    ^ self printStringLeftPaddedTo:size with:(Character space)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5756
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5757
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5758
     10 printStringLeftPaddedTo:10
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5759
     1 printStringLeftPaddedTo:10
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5760
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5761
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5762
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5763
printStringLeftPaddedTo:size ifLarger:alternative
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5764
    "return my printString as a right-adjusted string of length size;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5765
     characters on the left are filled with spaces.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5766
     If the printString is larger than size,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5767
     return the result from evaluating alternative."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5768
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5769
    ^ self printStringLeftPaddedTo:size with:(Character space) ifLarger:alternative
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5770
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5771
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5772
     12   printStringLeftPaddedTo:3 ifLarger:['***']
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5773
     123  printStringLeftPaddedTo:3 ifLarger:['***']
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5774
     1234 printStringLeftPaddedTo:3 ifLarger:['***']
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5775
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5776
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5777
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5778
printStringLeftPaddedTo:size with:padCharacter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5779
    "return my printString as a right-adjusted string of length size;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5780
     characters on the left are filled with padCharacter.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5781
     If the printString is longer than size, 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5782
     it is returned unchanged (i.e. not truncated)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5784
    ^ (self printString) leftPaddedTo:size with:padCharacter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5785
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5786
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5787
     123 printStringLeftPaddedTo:10 with:$.   
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5788
     1 printStringLeftPaddedTo:10 with:$.      
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5789
     (Float pi) printStringLeftPaddedTo:20 with:$*
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5790
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5791
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5792
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5793
printStringLeftPaddedTo:size with:padCharacter ifLarger:alternative
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5794
    "return my printString as a right-adjusted string of length size;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5795
     characters on the left are filled with padCharacter.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5796
     If the printString is larger than size,
369
claus
parents: 362
diff changeset
  5797
     return the result from evaluating alternative."
claus
parents: 362
diff changeset
  5798
claus
parents: 362
diff changeset
  5799
    |s|
claus
parents: 362
diff changeset
  5800
claus
parents: 362
diff changeset
  5801
    s := self printString.
claus
parents: 362
diff changeset
  5802
    s size > size ifTrue:[^ alternative value].
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5803
    ^ s leftPaddedTo:size with:padCharacter
369
claus
parents: 362
diff changeset
  5804
claus
parents: 362
diff changeset
  5805
    "
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5806
     12   printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5807
     123  printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5808
     1234 printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5809
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  5810
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  5811
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  5812
printStringPaddedTo:size
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5813
    "return a printed representation of the receiver,
369
claus
parents: 362
diff changeset
  5814
     padded with spaces (at the right) up to size.
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5815
     If the printString is longer than size, 
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5816
     it is returned unchanged (i.e. not truncated)"
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  5817
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  5818
    ^ self printStringPaddedTo:size with:(Character space)
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  5819
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5820
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5821
     123 printStringPaddedTo:10    
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5822
     1234567890123456 printStringPaddedTo:10  
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5823
     'hello' printStringPaddedTo:10   
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5824
    "
2
claus
parents: 1
diff changeset
  5825
!
claus
parents: 1
diff changeset
  5826
369
claus
parents: 362
diff changeset
  5827
printStringPaddedTo:size ifLarger:alternative
claus
parents: 362
diff changeset
  5828
    "return a printed representation of the receiver,
claus
parents: 362
diff changeset
  5829
     padded with spaces (at the right) up to size.
claus
parents: 362
diff changeset
  5830
     If the resulting printString is too large, 
claus
parents: 362
diff changeset
  5831
     return the result from evaluating alternative."
claus
parents: 362
diff changeset
  5832
claus
parents: 362
diff changeset
  5833
    ^ self printStringPaddedTo:size with:(Character space) ifLarger:alternative
claus
parents: 362
diff changeset
  5834
claus
parents: 362
diff changeset
  5835
    "
claus
parents: 362
diff changeset
  5836
     12   printStringPaddedTo:3 ifLarger:['***']   
claus
parents: 362
diff changeset
  5837
     123  printStringPaddedTo:3 ifLarger:['***']   
claus
parents: 362
diff changeset
  5838
     1234 printStringPaddedTo:3 ifLarger:['***']   
claus
parents: 362
diff changeset
  5839
    "
claus
parents: 362
diff changeset
  5840
!
claus
parents: 362
diff changeset
  5841
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5842
printStringPaddedTo:size with:padCharacter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5843
    "return a printed representation of the receiver,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5844
     padded with padCharacter (at the right) up to size.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5845
     If the printString is longer than size, 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5846
     it is returned unchanged (i.e. not truncated)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5847
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5848
    ^ (self printString) paddedTo:size with:padCharacter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5849
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5850
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5851
     123  printStringPaddedTo:10 with:$.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5852
     123  printStringPaddedTo:10 with:$*
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5853
     123  printStringPaddedTo:3 with:$*   
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5854
     1234 printStringPaddedTo:3 with:$*   
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5855
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5856
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5857
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5858
printStringPaddedTo:size with:padCharacter ifLarger:alternative
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5859
    "return a printed representation of the receiver,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5860
     padded with padCharacter (at the right) up to size.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5861
     If the resulting printString is too large, 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5862
     return the result from evaluating alternative."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5863
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5864
    |s|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5865
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5866
    s := self printString.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5867
    s size > size ifTrue:[^ alternative value].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5868
    ^ s paddedTo:size with:padCharacter
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5869
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5870
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5871
     123   printStringPaddedTo:3 with:$. ifLarger:['***']
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5872
     12345 printStringPaddedTo:3 with:$. ifLarger:['***']
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5873
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5874
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5875
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5876
printStringRightAdjustLen:size
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5877
    "obsolete - just a name confusion.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5878
     This method will go away ..."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5879
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5880
    ^ self printStringLeftPaddedTo:size
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5881
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5882
2
claus
parents: 1
diff changeset
  5883
printStringZeroPaddedTo:size
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5884
    "return a printed representation of the receiver, 
369
claus
parents: 362
diff changeset
  5885
     padded with zero (at the right) characters up to size.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  5886
     Usually used with float numbers."
2
claus
parents: 1
diff changeset
  5887
claus
parents: 1
diff changeset
  5888
    ^ self printStringPaddedTo:size with:$0
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  5889
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5890
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5891
     123.0 printStringZeroPaddedTo:10 
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5892
    "
2
claus
parents: 1
diff changeset
  5893
!
claus
parents: 1
diff changeset
  5894
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5895
store
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5896
    "store the receiver on standard output.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5897
     this method is useless, but included for compatibility."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5898
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5899
    self storeOn:Stdout
71
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5900
!
a42874820e27 *** empty log message ***
claus
parents: 56
diff changeset
  5901
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5902
storeCR
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5903
    "store the receiver on standard output; append a carriage return."
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5904
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5905
    self store.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5906
    Character cr print
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5907
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5908
    "Created: 20.5.1996 / 10:26:01 / cg"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5909
    "Modified: 20.5.1996 / 10:26:57 / cg"
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5910
!
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5911
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5912
storeNl
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  5913
    "store the receiver on standard output; append a newline.
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5914
     This method is included for backward compatibility-  use #storeCR."
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5915
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5916
    self storeCR.
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5917
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  5918
    "Modified: 20.5.1996 / 10:26:49 / cg"
460
7e058858cc3b New Method: displayOn:aGc at:aPoint (ST80-compatibility).
Stefan Vogel <sv@exept.de>
parents: 446
diff changeset
  5919
!
7e058858cc3b New Method: displayOn:aGc at:aPoint (ST80-compatibility).
Stefan Vogel <sv@exept.de>
parents: 446
diff changeset
  5920
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5921
storeOn:aStream
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5922
    "store the receiver on aStream; i.e. print an expression which will
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5923
     reconstruct the receiver.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5924
     Notice, that no self referencing or cyclic objects can be represented
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5925
     in this format.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5926
     Use storeBinaryOn:, which handles these cases correctly."
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5927
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5928
    |myClass hasSemi sz "{ Class: SmallInteger }" |
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5929
25
e34a6267c79b *** empty log message ***
claus
parents: 13
diff changeset
  5930
    thisContext isRecursive ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5931
        ('Object [error]: storeString of self referencing object.') errorPrintCR.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5932
        aStream nextPutAll:'#("recursive")'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5933
        ^ self
25
e34a6267c79b *** empty log message ***
claus
parents: 13
diff changeset
  5934
    ].
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5935
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5936
    myClass := self class.
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5937
    aStream nextPut:$(.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5938
    aStream nextPutAll:self class name.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5939
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5940
    hasSemi := false.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5941
    myClass isVariable ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5942
        aStream nextPutAll:' basicNew:'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5943
        self basicSize printOn:aStream
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5944
    ] ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5945
        aStream nextPutAll:' basicNew'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5946
    ].
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5947
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5948
    sz := myClass instSize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5949
    1 to:sz do:[:i | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5950
        aStream nextPutAll:' instVarAt:'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5951
        i printOn:aStream.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5952
        aStream nextPutAll:' put:'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5953
        (self instVarAt:i) storeOn:aStream.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5954
        aStream nextPut:$;.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5955
        hasSemi := true
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5956
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5957
    myClass isVariable ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5958
        sz := self basicSize.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5959
        1 to:sz do:[:i | 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5960
            aStream nextPutAll:' basicAt:'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5961
            i printOn:aStream.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5962
            aStream nextPutAll:' put:'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5963
            (self basicAt:i) storeOn:aStream.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5964
            aStream nextPut:$;.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5965
            hasSemi := true
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5966
        ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5967
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5968
    hasSemi ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  5969
        aStream nextPutAll:' yourself'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5970
    ].
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  5971
    aStream nextPut:$).
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5972
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5973
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5974
     |s|
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5975
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5976
     s := WriteStream on:(String new).
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5977
     ('hello' -> 'world') storeOn:s.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5978
     s := ReadStream on:(s contents).
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5979
     (Object readFrom:s) inspect
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5980
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5981
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5982
     |s|
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5983
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5984
     s := 'data' asFilename writeStream.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5985
     ('hello' -> 'world') storeOn:s.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5986
     s close.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5987
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5988
     s := 'data' asFilename readStream.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5989
     (Object readFrom:s) inspect
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5990
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5991
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5992
    "does not work example:"
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5993
    "
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5994
     |s a|
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5995
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5996
     a := Array new:2.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5997
     a at:1 put:a.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5998
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  5999
     s := 'data' asFilename writeStream.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6000
     a storeOn:s.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6001
     s close.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6002
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6003
     s := 'data' asFilename readStream.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6004
     (Object readFrom:s) inspect
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6005
    "
1417
59e7d3c1df6d showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
  6006
2287
3d5330d2b368 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2231
diff changeset
  6007
    "Modified: 28.1.1997 / 00:36:12 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6008
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6009
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  6010
storeString
293
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6011
    "return a string representing an expression to reconstruct the receiver.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6012
     Notice, that no self referencing or cyclic objects can be represented
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6013
     in this format.
31df3850e98c *** empty log message ***
claus
parents: 283
diff changeset
  6014
     Use storeBinaryOn:, which handles these cases correctly."
56
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  6015
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  6016
    |s|
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  6017
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  6018
    s := WriteStream on:(String new:50).
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  6019
    self storeOn:s.
be0ed17e6f85 *** empty log message ***
claus
parents: 49
diff changeset
  6020
    ^ s contents
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6021
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6022
5354
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6023
!Object methodsFor:'private'!
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6024
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6025
isHierarchicalItem
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6026
    "used to decide if the parent is a hierarchical item
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6027
     or the model
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6028
    "
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6029
    ^ false
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6030
! !
1df6e20fd208 added isHierarchicalItem
ca
parents: 5327
diff changeset
  6031
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6032
!Object methodsFor:'queries'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6033
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6034
basicSize
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6035
    "return the number of the receivers indexed instance variables,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6036
     0 if it has none.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6037
2148
f0a95dd96db5 comment
Claus Gittinger <cg@exept.de>
parents: 2147
diff changeset
  6038
     This method should NOT be redefined in any subclass (except with great care, for tuning)"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6039
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6040
%{  /* NOCONTEXT */
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6041
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6042
    REGISTER int nbytes;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6043
    REGISTER OBJ myClass;
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6044
    int nInstBytes;
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6045
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6046
    /*
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6047
     * notice the missing test for self being a nonNilObject -
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6048
     * this can be done since basicSize is defined both in UndefinedObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6049
     * and SmallInteger
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6050
     */
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6051
    myClass = __qClass(self);
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6052
    nbytes = __qSize(self);
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6053
    nInstBytes = OHDR_SIZE + __OBJS2BYTES__( __intVal(__ClassInstPtr(myClass)->c_ninstvars) );
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1129
diff changeset
  6054
3159
6adde9718bdc more variable-inst accesses; use switch instead of multiway-if.
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  6055
    switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6056
        case __MASKSMALLINT(POINTERARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6057
        case __MASKSMALLINT(WKPOINTERARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6058
            nbytes -= nInstBytes;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6059
            RETURN ( __MKSMALLINT(__BYTES2OBJS__(nbytes)) );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6060
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6061
        case __MASKSMALLINT(BYTEARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6062
            nbytes -= nInstBytes;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6063
            RETURN ( __MKSMALLINT(nbytes / sizeof(char)) );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6064
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6065
        case __MASKSMALLINT(FLOATARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6066
            nbytes -= nInstBytes;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6067
            RETURN ( __MKSMALLINT(nbytes / sizeof(float)) );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6068
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6069
        case __MASKSMALLINT(DOUBLEARRAY):
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6070
#ifdef __NEED_DOUBLE_ALIGN
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6071
            nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6072
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6073
            nbytes -= nInstBytes;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6074
            RETURN ( __MKSMALLINT(nbytes / sizeof(double)) );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6075
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6076
        case __MASKSMALLINT(WORDARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6077
        case __MASKSMALLINT(SWORDARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6078
            nbytes -= nInstBytes;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6079
            RETURN ( __MKSMALLINT(nbytes>>1) ); /* notice the hardcoded 2 here - not sizeof(short) */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6080
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6081
        case __MASKSMALLINT(LONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6082
        case __MASKSMALLINT(SLONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6083
            nbytes -= nInstBytes;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6084
            RETURN ( __MKSMALLINT(nbytes>>2) ); /* notice the hardcoded 4 here - not sizeof(int) */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6085
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6086
        case __MASKSMALLINT(LONGLONGARRAY):
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6087
        case __MASKSMALLINT(SLONGLONGARRAY):
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6088
#ifdef __NEED_LONGLONG_ALIGN
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6089
            nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6090
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6091
            nbytes -= nInstBytes;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6092
            RETURN ( __MKSMALLINT(nbytes>>3) ); /* notice the hardcoded 8 here - not sizeof(long long) */
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6093
    }
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6094
%}.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6095
    ^ 0
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6096
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6097
2575
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6098
byteSize
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6099
    "return the number of bytes in the receivers indexed instance variables,
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6100
     0 if it has none. This only returns non-zero for non-pointer indexed
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6101
     instvars i.e. byteArrays, wordArrays etc.
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6102
     Notice: for Strings the returned size may look strange.
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6103
     Only useful with binary storage."
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6104
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6105
    |myClass|
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6106
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6107
    myClass := self class.
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6108
    myClass isVariable ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6109
        myClass isPointers ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6110
            myClass isBytes ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6111
                ^ self basicSize.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6112
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6113
            myClass isWords ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6114
                ^ self basicSize * 2.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6115
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6116
            myClass isSignedWords ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6117
                ^ self basicSize * 2.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6118
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6119
            myClass isLongs ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6120
                ^ self basicSize * 4.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6121
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6122
            myClass isSignedLongs ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6123
                ^ self basicSize * 4.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6124
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6125
            myClass isLongLongs ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6126
                ^ self basicSize * 8.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6127
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6128
            myClass isSignedLongLongs ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6129
                ^ self basicSize * 8.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6130
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6131
            myClass isFloats ifTrue:[
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  6132
                ^ self basicSize * (ExternalBytes sizeofFloat)
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6133
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6134
            myClass isDoubles ifTrue:[
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  6135
                ^ self basicSize * (ExternalBytes sizeofDouble)
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6136
            ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6137
            self halt:'oops'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6138
        ]
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6139
    ].
2575
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6140
    ^ 0
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6141
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6142
    "
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6143
     Point new byteSize   
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6144
     'hello' byteSize     
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6145
     (ByteArray with:1 with:2) byteSize 
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6146
     (FloatArray with:1.5) byteSize    
3921
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6147
     (DoubleArray with:1.5) byteSize    
8e07cb118aa3 added longlong indexed instvars;
Claus Gittinger <cg@exept.de>
parents: 3841
diff changeset
  6148
     (WordArray with:1 with:2) byteSize    
2575
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6149
    "
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6150
!
797f7408e03c added #byteSize (for binary storage)
Claus Gittinger <cg@exept.de>
parents: 2574
diff changeset
  6151
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6152
class
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6153
    "return the receivers class"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6154
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6155
%{  /* NOCONTEXT */
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6156
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6157
    RETURN ( __Class(self) );
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6158
%}
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6159
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6160
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6161
respondsTo:aSelector
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6162
    "return true, if the receiver implements a method with selector equal
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6163
     to aSelector; i.e. if there is a method for aSelector in either the
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6164
     receivers class or one of its superclasses.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6165
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6166
     Notice, that this does not imply, that such a message can be sent without
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6167
     an error being raised. For example, an implementation could send
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6168
     #shouldNotImplement or #subclassResponsibility."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6169
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6170
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6171
     should we go via the cache, or search (by class) ?
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6172
     The first is faster, most of the time; while the 2nd fills
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6173
     the cache with useless data if this is sent in a loop over all objects.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6174
     For now, use the cache ...
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6175
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6176
%{  /* NOCONTEXT */
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6177
829
fc386319f41c removed external function defs (soon no longer allowed)
Claus Gittinger <cg@exept.de>
parents: 816
diff changeset
  6178
    if (__lookup(__Class(self), aSelector) == nil) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6179
        RETURN ( false );
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6180
    }
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6181
    RETURN ( true );
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6182
%}
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6183
.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6184
    ^ self class canUnderstand:aSelector
5418
b456f99b6c8c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5408
diff changeset
  6185
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6186
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6187
    "'aString' respondsTo:#+"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6188
    "'aString' respondsTo:#,"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6189
    "'aString' respondsTo:#collect:"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6190
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6191
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6192
respondsToArithmetic
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6193
    "return true, if the receiver responds to arithmetic messages.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6194
     false is returned here - the method is redefined in ArithmeticValue."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6195
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6196
    ^ false
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6197
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6198
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6199
size
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6200
    "return the number of the receivers indexed instance variables;
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6201
     this method may be redefined in subclasses"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6202
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6203
    ^ self basicSize
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6204
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6205
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6206
species
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6207
    "return a class which is similar to (or the same as) the receivers class.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6208
     This is used to create an appropriate object when creating derived
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6209
     copies in the collection classes (sometimes redefined)."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6210
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6211
    ^ self class
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6212
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6213
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6214
yourself
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6215
    "return the receiver - used for cascades to return self at the end"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6216
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6217
    ^ self
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6218
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6219
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6220
!Object methodsFor:'secure message sending'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6221
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6222
askFor:aSelector
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6223
    "try to send the receiver the message, aSelector.
4322
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6224
     If it does not understand it, return false. 
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6225
     Otherwise the real value returned.
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6226
     Useful to send messages such as: #isColor to unknown
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6227
     receivers."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6228
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6229
    ^ self perform:aSelector ifNotUnderstood:[false]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6230
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6231
    "
4322
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6232
     1 askFor:#isColor     
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6233
     Color red askFor:#isColor 
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6234
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6235
     1 askFor:#isFoo     
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6236
     Color red askFor:#isFoo 
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6237
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6238
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6239
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6240
perform:aSelector ifNotUnderstood:exceptionBlock
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6241
    "try to send message aSelector to the receiver.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6242
     If its understood, return the methods returned value,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6243
     otherwise return the value of the exceptionBlock"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6244
3994
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6245
    |val ok|
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6246
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6247
    MessageNotUnderstoodSignal handle:[:ex |
4322
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6248
        "/ reject, if the bad message is not the one
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6249
        "/ we have sent originally
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6250
        ex parameter selector == aSelector ifFalse:[
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6251
            ex reject
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6252
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6253
    ] do:[
3994
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6254
        val := self perform:aSelector.
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6255
        ok := true.
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6256
    ].
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6257
    ok isNil ifTrue:[
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6258
        ^ exceptionBlock value
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6259
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6260
    ^ val
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6261
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6262
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6263
     1.2345 perform:#foo ifNotUnderstood:['sorry'] 
3994
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6264
     1.2345 perform:#sqrt ifNotUnderstood:['sorry'] 
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6265
     12345 perform:#sqrt ifNotUnderstood:['sorry']  
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6266
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6267
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6268
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6269
perform:aSelector with:argument ifNotUnderstood:exceptionBlock
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6270
    "try to send message aSelector to the receiver.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6271
     If its understood, return the methods returned value,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6272
     otherwise return the value of the exceptionBlock"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6273
3994
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6274
    |val ok|
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6275
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6276
    MessageNotUnderstoodSignal handle:[:ex |
4322
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6277
        "/ reject, if the bad message is not the one
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6278
        "/ we have sent originally
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6279
        ex parameter selector == aSelector ifFalse:[
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6280
            ex reject
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6281
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6282
    ] do:[
3994
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6283
        val := self perform:aSelector with:argument.
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6284
        ok := true.
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6285
    ].
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6286
    ok isNil ifTrue:[
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6287
        ^ exceptionBlock value
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6288
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6289
    ^ val
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6290
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6291
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6292
     |unknown|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6293
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6294
     unknown := 1.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6295
     (unknown perform:#+ with:2 ifNotUnderstood:['sorry']) printNewline.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6296
     unknown := 'high there'.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6297
     (unknown perform:#+ with:2 ifNotUnderstood:['sorry']) printNewline.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6298
    "
2506
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6299
!
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6300
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6301
perform:aSelector withArguments:argumentArray ifNotUnderstood:exceptionBlock
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6302
    "try to send message aSelector to the receiver.
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6303
     If its understood, return the methods returned value,
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6304
     otherwise return the value of the exceptionBlock"
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6305
3994
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6306
    |val ok|
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6307
2506
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6308
    MessageNotUnderstoodSignal handle:[:ex |
4322
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6309
        "/ reject, if the bad message is not the one
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6310
        "/ we have sent originally
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6311
        ex parameter selector == aSelector ifFalse:[
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6312
            ex reject
ae629533c1ef in #perform:ifNotUnderstood: - reject if the bad selector
Claus Gittinger <cg@exept.de>
parents: 4287
diff changeset
  6313
        ]
2506
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6314
    ] do:[
3994
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6315
        val := self perform:aSelector withArguments:argumentArray.
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6316
        ok := true.
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6317
    ].
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6318
    ok isNil ifTrue:[
e156620a43df slightly tuned #perform:ifNotUnderstood: methods.
Claus Gittinger <cg@exept.de>
parents: 3961
diff changeset
  6319
        ^ exceptionBlock value
2506
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6320
    ].
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6321
    ^ val
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6322
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6323
    "
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6324
     |unknown|
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6325
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6326
     unknown := 1.
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6327
     (unknown perform:#+ withArguments:#(2) ifNotUnderstood:['sorry']) printNewline.
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6328
     unknown := 'high there'.
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6329
     (unknown perform:#+ withArguments:#(2) ifNotUnderstood:['sorry']) printNewline.
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6330
    "
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6331
255c87b6fb4f added #perform:withArguments:ifNotUnderstood:
Claus Gittinger <cg@exept.de>
parents: 2505
diff changeset
  6332
    "Modified: 27.3.1997 / 14:13:16 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6333
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6334
2448
ab70ff46b982 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2445
diff changeset
  6335
!Object methodsFor:'signal constants'!
ab70ff46b982 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2445
diff changeset
  6336
ab70ff46b982 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2445
diff changeset
  6337
messageNotUnderstoodSignal
ab70ff46b982 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2445
diff changeset
  6338
    ^ MessageNotUnderstoodSignal
ab70ff46b982 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2445
diff changeset
  6339
ab70ff46b982 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2445
diff changeset
  6340
    "Created: 6.3.1997 / 15:46:52 / cg"
ab70ff46b982 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2445
diff changeset
  6341
! !
ab70ff46b982 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2445
diff changeset
  6342
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6343
!Object methodsFor:'special queries'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6344
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6345
allOwners
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6346
    "return a collection of all objects referencing the receiver"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6347
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6348
    ^ ObjectMemory whoReferences:self
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6349
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6350
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6351
references:anObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6352
    "return true, if the receiver refers to the argument, anObject.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6353
     - for debugging only"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6354
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6355
%{  /* NOCONTEXT */
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6356
    OBJ cls, flags;
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6357
    int nInsts, i;
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6358
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6359
    if (! __isNonNilObject(self)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6360
        RETURN (false);
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6361
    }
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6362
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6363
    /*
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6364
     * a little optimization: use the fact that all old objects
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6365
     * refering to a new object are on the remSet; if I am not,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6366
     * a trivial reject is possible, if anObject is a newbee
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6367
     */
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6368
    if (__isNonNilObject(anObject)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6369
        if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6370
            int spc;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6371
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6372
            if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6373
                RETURN (false);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6374
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6375
        }
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6376
    }
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6377
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6378
    cls = __qClass(self);
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6379
    if (cls == anObject) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6380
        RETURN (true);
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6381
    }
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6382
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6383
    flags = __ClassInstPtr(cls)->c_flags;
1386
a31cecccdfd8 _MASKSMALLINT -> __MASKSMALLINT;
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  6384
    if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6385
        nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6386
    } else {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6387
        nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6388
    }
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6389
    if (! nInsts) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6390
        RETURN (false);
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6391
    }
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6392
#if defined(memsrch4)
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6393
    if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6394
        RETURN (true);
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6395
    }
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6396
#else
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6397
    for (i=0; i<nInsts; i++) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6398
        if (__InstPtr(self)->i_instvars[i] == anObject) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6399
            RETURN (true);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6400
        }
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6401
    }
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6402
#endif /* memsrch4 */
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6403
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6404
%}.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6405
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6406
"/    |myClass 
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6407
"/     numInst "{ Class: SmallInteger }" |
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6408
"/
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6409
"/    myClass := self class.
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6410
"/
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6411
"/    "check the class"
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6412
"/    (myClass == anObject) ifTrue:[^ true].
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6413
"/
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6414
"/    "check the instance variables"
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6415
"/    numInst := myClass instSize.
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6416
"/    1 to:numInst do:[:i | 
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6417
"/      ((self instVarAt:i) == anObject) ifTrue:[^ true]
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6418
"/    ].
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6419
"/
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6420
"/    "check the indexed variables"
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6421
"/    myClass isVariable ifTrue:[
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6422
"/      myClass isPointers ifFalse:[
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6423
"/          "/
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6424
"/          "/ we could argue about the following unconditional return:
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6425
"/          "/ it says that a non pointer array never has a reference to the
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6426
"/          "/ corresponding object - not mimicing a reference to a copy of the
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6427
"/          "/ integer. However, it avoids useless searches in huge byteArray
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6428
"/          "/ like objects when searching for owners. If in doubt, remove it.
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6429
"/          "/ A consequence of the return below is that #[1 2 3] will say that it
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6430
"/          "/ does not refer to the number 2 (think of keeping a copy instead)
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6431
"/
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6432
"/          ^ false.
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6433
"/
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6434
"/          "/ alternative:
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6435
"/          "/  anObject isNumber ifFalse:[^ false].
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6436
"/      ].
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6437
"/
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6438
"/      "/
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6439
"/      "/ because arrays are so common, and those have a highly tuned
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6440
"/      "/ idenitytIndex method, use it
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6441
"/      "/
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6442
"/      myClass == Array ifTrue:[
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6443
"/          ^ (self identityIndexOf:anObject) ~~ 0
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6444
"/      ].
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6445
"/
2647
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6446
"/      "/
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6447
"/      "/ otherwise, do it the slow way
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6448
"/      "/
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6449
"/      numInst := self basicSize.
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6450
"/      1 to:numInst do:[:i | 
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6451
"/          ((self basicAt:i) == anObject) ifTrue:[^ true]
1167aaee163e a much faster shallowCopy
Claus Gittinger <cg@exept.de>
parents: 2575
diff changeset
  6452
"/      ]
1109
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6453
"/    ].
38956a3cd61e speeded up #references: (needed for allOwners etc.)
Claus Gittinger <cg@exept.de>
parents: 1101
diff changeset
  6454
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6455
    ^ false
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6456
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6457
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6458
     |v|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6459
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6460
     v := View new initialize.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6461
     v references:Display. 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6462
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6463
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6464
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6465
referencesAny:aCollection
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6466
    "return true, if the receiver refers to any object from 
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6467
     the argument, aCollection.
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6468
     - for debugging only"
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6469
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6470
%{  
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6471
    OBJ cls, flags;
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6472
    int nInsts, inst;
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6473
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6474
    if (! __isNonNilObject(self)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6475
        RETURN (false);
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6476
    }
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6477
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6478
    if (__isArray(aCollection)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6479
        int nObjs = __arraySize(aCollection);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6480
        char *minAddr = 0, *maxAddr = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6481
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6482
        if (nObjs == 0) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6483
            RETURN (false);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6484
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6485
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6486
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6487
         * a little optimization: use the fact that all old objects
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6488
         * refering to a new object are on the remSet; if I am not,
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6489
         * a trivial reject is possible, if all objects are newbees.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6490
         * as a side effect, gather min/max addresses
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6491
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6492
        if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6493
            int allNewBees = 1;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6494
            int i;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6495
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6496
            minAddr = (char *)(__ArrayInstPtr(aCollection)->a_element[0]);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6497
            maxAddr = minAddr;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6498
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6499
            for (i=0; i<nObjs; i++) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6500
                OBJ anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6501
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6502
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6503
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6504
                if (__isNonNilObject(anObject)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6505
                    int spc;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6506
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6507
                    if (((spc = __qSpace(anObject)) != NEWSPACE) && (spc != SURVSPACE)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6508
                        allNewBees = 0;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6509
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6510
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6511
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6512
                if ((char *)anObject < minAddr) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6513
                    minAddr = (char *)anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6514
                } else if ((char *)anObject > maxAddr) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6515
                    maxAddr = (char *)anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6516
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6517
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6518
            if (allNewBees) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6519
                RETURN (false);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6520
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6521
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6522
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6523
        /*
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6524
         * fetch min/max in searchList (if not already done)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6525
         */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6526
        if (minAddr == 0) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6527
            int i;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6528
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6529
            for (i=0; i<nObjs; i++) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6530
                OBJ anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6531
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6532
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6533
                if ((char *)anObject < minAddr) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6534
                    minAddr = (char *)anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6535
                } else if ((char *)anObject > maxAddr) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6536
                    maxAddr = (char *)anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6537
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6538
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6539
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6540
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6541
        cls = __qClass(self);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6542
        if (((char *)cls >= minAddr) && ((char *)cls <= maxAddr)) {
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6543
#if defined(memsrch4)
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6544
            if (memsrch4(__ArrayInstPtr(aCollection)->a_element, (INT)cls, nObjs)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6545
                RETURN (true);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6546
            }
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6547
#else
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6548
            int i;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6549
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6550
            for (i=0; i<nObjs; i++) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6551
                OBJ anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6552
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6553
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6554
                if (cls == anObject) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6555
                    RETURN (true);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6556
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6557
            }
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6558
#endif /* memsrch4 */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6559
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6560
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6561
        flags = __ClassInstPtr(cls)->c_flags;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6562
        if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6563
            nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6564
        } else {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6565
            nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6566
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6567
        if (! nInsts) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6568
            RETURN (false);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6569
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6570
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6571
        if (nObjs == 1) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6572
            /* better reverse the loop */
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6573
            OBJ anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6574
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6575
            anObject = __ArrayInstPtr(aCollection)->a_element[0];
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6576
#if defined(memsrch4)
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6577
            if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6578
                RETURN (true);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6579
            }
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6580
#else
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6581
            for (inst=0; inst<nInsts; inst++) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6582
                if ((__InstPtr(self)->i_instvars[inst]) == anObject) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6583
                    RETURN (true);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6584
                }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6585
            }
3694
429ec70365a6 tuned #referencesAny (for ref-chain search)
Claus Gittinger <cg@exept.de>
parents: 3622
diff changeset
  6586
#endif
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6587
            RETURN (false);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6588
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6589
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6590
        for (inst=0; inst<nInsts; inst++) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6591
            OBJ instVar = __InstPtr(self)->i_instvars[inst];
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6592
            int i;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6593
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6594
            if (((char *)instVar >= minAddr) && ((char *)instVar <= maxAddr)) {
3694
429ec70365a6 tuned #referencesAny (for ref-chain search)
Claus Gittinger <cg@exept.de>
parents: 3622
diff changeset
  6595
#if defined(memsrch4)
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6596
                if (memsrch4(__ArrayInstPtr(aCollection)->a_element, (INT)instVar, nObjs)) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6597
                    RETURN (true);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6598
                }
3694
429ec70365a6 tuned #referencesAny (for ref-chain search)
Claus Gittinger <cg@exept.de>
parents: 3622
diff changeset
  6599
#else
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6600
                for (i=0; i<nObjs; i++) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6601
                    OBJ anObject;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6602
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6603
                    anObject = __ArrayInstPtr(aCollection)->a_element[i];
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6604
                    if (instVar == anObject) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6605
                        RETURN (true);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6606
                    }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6607
                }
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6608
#endif /* memsrch4 */
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6609
            }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6610
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6611
        RETURN (false);
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6612
    }
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6613
%}.
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6614
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6615
    aCollection do:[:el |
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6616
        (self references:el) ifTrue:[^ true].
3259
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6617
    ].
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6618
    ^ false
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6619
!
ead60aee4cd3 tuned #references: & added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  6620
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6621
referencesDerivedInstanceOf:aClass
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6622
    "return true, if the receiver refers to an instance of
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6623
     the argument, aClass or its subclass. This method exists
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6624
     to support searching for users of a class."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6625
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6626
    |myClass 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6627
     numInst "{ Class: SmallInteger }" |
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6628
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6629
    myClass := self class.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6630
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6631
    "check the class"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6632
    (myClass isKindOf:aClass) ifTrue:[^ true].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6633
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6634
    "check the instance variables"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6635
    numInst := myClass instSize.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6636
    1 to:numInst do:[:i | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6637
        ((self instVarAt:i) isKindOf:aClass) ifTrue:[^ true]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6638
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6639
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6640
    "check the indexed variables"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6641
    myClass isVariable ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6642
        myClass isPointers ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6643
            "no need to search in non pointer fields"
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6644
            ((aClass == Number) or:[aClass isSubclassOf:Number]) ifFalse:[^ false].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6645
        ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6646
        numInst := self basicSize.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6647
        1 to:numInst do:[:i | 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6648
            ((self basicAt:i) isKindOf:aClass) ifTrue:[^ true]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6649
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6650
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6651
    ^ false
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6652
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6653
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6654
     (1 @ 3.4) referencesDerivedInstanceOf:Number  
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6655
     (1 @ 3.4) referencesDerivedInstanceOf:Array   
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6656
     View new initialize referencesDerivedInstanceOf:DeviceWorkstation  
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6657
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6658
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6659
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6660
referencesInstanceOf:aClass
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6661
    "return true, if the receiver refers to an instance of
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6662
     the argument, aClass.This method exists
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6663
     to support searching for users of a class."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6664
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6665
    |myClass 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6666
     numInst "{ Class: SmallInteger }" |
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6667
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6668
    myClass := self class.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6669
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6670
    "check the class"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6671
    (myClass isMemberOf:aClass) ifTrue:[^ true].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6672
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6673
    "check the instance variables"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6674
    numInst := myClass instSize.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6675
    1 to:numInst do:[:i | 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6676
        ((self instVarAt:i) isMemberOf:aClass) ifTrue:[^ true]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6677
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6678
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6679
    "check the indexed variables"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6680
    myClass isVariable ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6681
        myClass isPointers ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6682
            "no need to search in non-pointer indexed fields"
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6683
            myClass isLongs ifTrue:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6684
                (aClass == SmallInteger or:[aClass == LargeInteger]) ifFalse:[^ false].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6685
            ] ifFalse:[
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6686
                myClass isFloatsOrDoubles ifTrue:[^ aClass == Float].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6687
                ^ aClass == SmallInteger
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6688
            ]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6689
        ].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6690
        numInst := self basicSize.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6691
        1 to:numInst do:[:i | 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6692
            ((self basicAt:i) isMemberOf:aClass) ifTrue:[^ true]
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6693
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6694
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6695
    ^ false
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6696
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6697
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6698
     (1 @ 3.4) referencesInstanceOf:Float     
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6699
     (1 @ 3.4) referencesInstanceOf:Fraction    
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6700
     View new initialize referencesInstanceOf:(Display class)  
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6701
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6702
! !
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6703
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6704
!Object methodsFor:'synchronized evaluation'!
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6705
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6706
freeSynchronizationSemaphore    
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6707
    "free synchronizationSemaphore. May be used, to save memory when
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6708
     an object is no longer used synchronized."
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6709
2342
4e72f4d7caf1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2341
diff changeset
  6710
    |sema|
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6711
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6712
    sema := self synchronizationSemaphore.
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6713
    sema notNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6714
        sema wait.              "/ get lock
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6715
        self synchronizationSemaphore:nil.
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6716
    ].
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6717
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6718
    "
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6719
     self synchronized:[].
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6720
     self synchronizationSemaphore.
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6721
     self freeSynchronizationSemaphore.
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6722
    "
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6723
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6724
    "Created: 28.1.1997 / 19:31:20 / stefan"
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6725
    "Modified: 28.1.1997 / 19:47:55 / stefan"
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6726
!
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6727
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6728
synchronizationSemaphore
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6729
    "return the synchronization semaphore for myself.
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6730
     subclasses may redefine"
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6731
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6732
    ^ SynchronizationSemaphores at:self ifAbsent:[].
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6733
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6734
    "
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6735
      self synchronizationSemaphore
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6736
    "
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6737
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6738
    "Modified: 28.1.1997 / 19:47:09 / stefan"
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6739
!
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6740
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6741
synchronizationSemaphore:aSemaphore
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6742
    "set the synchronisationSemaphore for myself.
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6743
     subclasses may redefine this method"
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6744
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6745
    aSemaphore isNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6746
        "/ remove Semaphore
5424
3ffaef20cfd0 removeKey:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 5421
diff changeset
  6747
        SynchronizationSemaphores removeKey:self ifAbsent:nil.
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6748
    ] ifFalse:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6749
        SynchronizationSemaphores at:self put:aSemaphore.
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6750
    ].
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6751
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6752
    "Modified: 28.1.1997 / 19:37:48 / stefan"
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6753
!
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6754
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6755
synchronized:aBlock
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6756
    "evaluate aBlock synchronized, i.e. use a monitor for this object"
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6757
2412
f20a5b10e6ab Further optim. for #synchronized.
Stefan Vogel <sv@exept.de>
parents: 2359
diff changeset
  6758
    |sema blocked gotSema|
2327
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6759
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6760
    blocked := OperatingSystem blockInterrupts.
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6761
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6762
    "/ the following avoids creation of an additional
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6763
    "/ block in the common case
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6764
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6765
    sema := self synchronizationSemaphore.
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6766
    sema isNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6767
        "get a locked semaphore (with count = 0)"
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6768
        sema := Semaphore new.  
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6769
        self synchronizationSemaphore:sema.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6770
        blocked ifFalse:[OperatingSystem unblockInterrupts].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6771
        ^ aBlock valueNowOrOnUnwindDo:[sema signal].
2327
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6772
    ].
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6773
2412
f20a5b10e6ab Further optim. for #synchronized.
Stefan Vogel <sv@exept.de>
parents: 2359
diff changeset
  6774
    "
f20a5b10e6ab Further optim. for #synchronized.
Stefan Vogel <sv@exept.de>
parents: 2359
diff changeset
  6775
     Poll sema (never waits).
f20a5b10e6ab Further optim. for #synchronized.
Stefan Vogel <sv@exept.de>
parents: 2359
diff changeset
  6776
     Assuming that this is the common operation, this saves the creation
f20a5b10e6ab Further optim. for #synchronized.
Stefan Vogel <sv@exept.de>
parents: 2359
diff changeset
  6777
     of some blocks.
f20a5b10e6ab Further optim. for #synchronized.
Stefan Vogel <sv@exept.de>
parents: 2359
diff changeset
  6778
    "
f20a5b10e6ab Further optim. for #synchronized.
Stefan Vogel <sv@exept.de>
parents: 2359
diff changeset
  6779
    (sema waitWithTimeout:0) notNil ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6780
        blocked ifFalse:[OperatingSystem unblockInterrupts].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6781
        ^ aBlock valueNowOrOnUnwindDo:[sema signal].
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6782
    ].
2327
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6783
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6784
    [
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6785
        gotSema := sema wait.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6786
        blocked ifFalse:[OperatingSystem unblockInterrupts].
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6787
        ^ aBlock value.
2327
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6788
    ] valueNowOrOnUnwindDo:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6789
        gotSema notNil ifTrue:[gotSema signal]
2327
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6790
    ].
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6791
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6792
    "
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6793
       [Object synchronized:[Delay waitForSeconds:2. Transcript showCR:'1']] fork.
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6794
       [Object synchronized:[Delay waitForSeconds:2. Transcript showCR:'2']] fork.
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6795
    "
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6796
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6797
    "Created: 28.1.1997 / 17:52:56 / stefan"
2327
90f4a4b737d9 synchronized
Claus Gittinger <cg@exept.de>
parents: 2296
diff changeset
  6798
    "Modified: 30.1.1997 / 13:38:54 / cg"
2412
f20a5b10e6ab Further optim. for #synchronized.
Stefan Vogel <sv@exept.de>
parents: 2359
diff changeset
  6799
    "Modified: 20.2.1997 / 09:43:35 / stefan"
2295
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6800
! !
75eccb7762c1 Add #synchronized: method.
Stefan Vogel <sv@exept.de>
parents: 2287
diff changeset
  6801
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6802
!Object methodsFor:'system primitives'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6803
1957
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6804
asOop
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6805
    "ST-80 compatibility:
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6806
     ST-80 returns an OOP-identity based number here (I guess: its address
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6807
     or index); since ST/X has no such thing, and the objects address cannot
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6808
     be used (since its changing over time), we return the objects identityHash 
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6809
     key, which provides (at least) some identity indication.
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6810
     However, notice that (in contrast to ST-80's #asOop), the identityHash
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6811
     key of two non-identical objects may be the same.
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6812
     You'd better not use it - especially do not misuse it."
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6813
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6814
    ^ self identityHash
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6815
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6816
    "Created: 9.11.1996 / 19:09:56 / cg"
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6817
    "Modified: 9.11.1996 / 19:16:04 / cg"
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6818
!
3988b7bd159b added #asOop.
Claus Gittinger <cg@exept.de>
parents: 1905
diff changeset
  6819
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6820
become:anotherObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6821
    "make all references to the receiver become references to anotherObject
859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6822
     and vice-versa. Notice the vice-versa; see #becomeSameAs: for a one-way become.
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6823
     This can be a very dangerous operation - be warned.
861
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6824
     In general, using #become: should be avoided if possible, since it may 
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6825
     produce many strange effects (think of hashing in Sets, Dictionaries etc.).
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6826
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6827
     This may also be an expensive (i.e. slow) operation, 
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6828
     since in the worst case, the whole memory has to be searched for 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6829
     references to the two objects (although the primitive tries hard to
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6830
     limit the search, for acceptable performance in most cases). 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6831
     This method fails, if the receiver or the argument is a SmallInteger 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6832
     or nil, or is a context of a living method (i.e. one that has not already 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6833
     returned).
859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6834
     (notice that #become: is not used heavily by the system 
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6835
      - the Collection-classes have been rewritten to not use it.)"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6836
%{
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1685
diff changeset
  6837
    if (__primBecome(self, anotherObject)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6838
        RETURN ( self );
859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6839
    }
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6840
%}.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6841
    self primitiveFailed
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6842
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6843
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6844
becomeNil
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6845
    "make all references to the receiver become nil - effectively getting
859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6846
     rid of the receiver. 
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6847
     This can be a very dangerous operation - be warned.
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6848
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6849
     This may be an expensive (i.e. slow) operation.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6850
     The receiver may not be a SmallInteger or a context of a living method."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6851
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6852
%{
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1685
diff changeset
  6853
    if (__primBecomeNil(self)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6854
        RETURN ( nil );
859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6855
    }
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6856
%}.
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6857
    self primitiveFailed
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6858
!
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6860
becomeSameAs:anotherObject
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6861
    "make all references to the receiver become references to anotherObject
861
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6862
     but NOT vice versa (as done in #become:).
859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6863
     This can be a very dangerous operation - be warned.
861
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6864
     In general, using #become: should be avoided if possible, since it may 
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6865
     produce many strange effects (think of hashing in Sets, Dictionaries etc.).
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6866
2b4dc0a4f65a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 859
diff changeset
  6867
     This may also be an expensive (i.e. slow) operation,
859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6868
     since in the worst case, the whole memory has to be searched for
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6869
     references to the two objects (although the primitive tries hard to
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6870
     limit the search, for acceptable performance in most cases).
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6871
     This method fails, if the receiver or the argument is a SmallInteger
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6872
     or nil, or is a context of a living method (i.e. one that has not already returned)."
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6873
%{
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1685
diff changeset
  6874
    if (__primBecomeSameAs(self, anotherObject)) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  6875
        RETURN ( self );
859
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6876
    }
a532cd2450dd added becomeSameAs:
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  6877
%}.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6878
    self primitiveFailed
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6879
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6880
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6881
changeClassTo:otherClass
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6882
    "changes the class of the receiver to the argument, otherClass.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6883
     This is only allowed (possible), if the receivers class and the argument
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6884
     have the same structure (i.e. number of named instance variables and
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6885
     type of indexed instance variables). 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6886
     If the structures do not match, or any of the original class or new class
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6887
     is UndefinedObject or a Smallinteger, a primitive error is triggered."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6888
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6889
    |myClass ok|
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6890
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6891
    "check for UndefinedObject/SmallInteger receiver or newClass"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6892
%{
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1129
diff changeset
  6893
    {
4363
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6894
        OBJ other = otherClass;
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6895
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6896
        if (__isNonNilObject(self) 
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6897
         && __isNonNilObject(other)
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6898
         && (other != UndefinedObject)
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6899
         && (other != SmallInteger)) {
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6900
            ok = true;
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6901
        } else {
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6902
            ok = false;
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6903
        }
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6904
    }
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6905
%}.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6906
    ok ifTrue:[
4363
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6907
        ok := false.
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6908
        myClass := self class.
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6909
        myClass flags == otherClass flags ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6910
            myClass instSize == otherClass instSize ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6911
                "same instance layout and types: its ok to do it"
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6912
                ok := true.
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6913
            ] ifFalse:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6914
                myClass isPointers ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6915
                    myClass isVariable ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6916
                        ok := true
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6917
                    ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6918
                ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6919
            ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6920
        ] ifFalse:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6921
            myClass isPointers ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6922
                "if newClass is a variable class, with instSize <= my instsize,
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6923
                 we can do it (effectively mapping additional instvars into the
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6924
                 variable part) - usefulness is questionable, though"
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6925
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6926
                otherClass isPointers ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6927
                    otherClass isVariable ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6928
                        otherClass instSize <= (myClass instSize + self basicSize) 
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6929
                        ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6930
                            ok := true
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6931
                        ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6932
                    ] ifFalse:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6933
                        otherClass instSize == (myClass instSize + self basicSize) 
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6934
                        ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6935
                            ok := true
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6936
                        ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6937
                    ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6938
                ] ifFalse:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6939
                    "it does not make sense to convert pointers to bytes ..."
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6940
                ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6941
            ] ifFalse:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6942
                "does it make sense, to convert bits ?"
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6943
                "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6944
                (myClass isBitsExtended and:[otherClass isBitsExtended]) ifTrue:[
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6945
                    ok := true
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6946
                ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6947
            ]
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6948
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6949
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6950
    ok ifTrue:[
4363
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6951
        "now, change the receivers class ..."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6952
%{
4363
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6953
        {
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6954
            OBJ me = self;
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6955
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6956
            __qClass(me) = otherClass;
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6957
            __STORE(me, otherClass);
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6958
            RETURN (me);
f07f766dbb93 oops - changeClassTo: did not accept extended bit-indexed classes
Claus Gittinger <cg@exept.de>
parents: 4360
diff changeset
  6959
        }
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6960
%}.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6961
    ].
1022
f526a827ea1a allow changeClass of bitObjects
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
  6962
f526a827ea1a allow changeClass of bitObjects
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
  6963
    "
f526a827ea1a allow changeClass of bitObjects
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
  6964
     the receiver cannot be represented as a instance of
f526a827ea1a allow changeClass of bitObjects
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
  6965
     the desired class.
f526a827ea1a allow changeClass of bitObjects
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
  6966
     For example, you cannot change a bitInstance (byteArray etc.) 
f526a827ea1a allow changeClass of bitObjects
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
  6967
     into a pointer object and vice versa.
f526a827ea1a allow changeClass of bitObjects
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
  6968
    "
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6969
    self primitiveFailed
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6970
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6971
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6972
changeClassToThatOf:anObject
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6973
    "changes the class of the receiver to that of the argument, anObject.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6974
     This is only allowed (possible), if the receivers class and the arguments
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6975
     class have the same structure (i.e. number of named instance variables and 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6976
     type of indexed instance variables). If the structures do not match, or any
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6977
     of the objects is nil or a Smallinteger, a primitive error is triggered."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6978
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6979
    self changeClassTo:(anObject class)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6980
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  6981
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  6982
!Object methodsFor:'testing'!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  6983
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  6984
? defaultValue
3465
1ba2cd91b1b5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3464
diff changeset
  6985
     "a syntactic shugar-piece:
1ba2cd91b1b5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3464
diff changeset
  6986
      if the receiver is nil, return the defaultValue;
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  6987
      otherwise, return the receiver.
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  6988
      This method is only redefined in UndefinedObject - therefore,
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  6989
      the recevier is retuned here.
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  6990
1958
d8d575552c87 commentary
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
  6991
      Thus, if foo and bar are simple variables or constants,
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  6992
          foo ? bar
1958
d8d575552c87 commentary
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
  6993
      is the same as:
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  6994
          (foo isNil ifTrue:[bar] ifFalse:[foo])
1958
d8d575552c87 commentary
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
  6995
d8d575552c87 commentary
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
  6996
      if they are message sends, the equivalent code is:
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  6997
          [
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  6998
              |t1 t2|
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  6999
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7000
              t1 := foo.
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7001
              t2 := bar.
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7002
              t1 isNil ifTrue:[t2] ifFalse:[t1]
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7003
          ] value
1958
d8d575552c87 commentary
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
  7004
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7005
      Can be used to provide defaultValues to variables,
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7006
      as in:
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7007
          foo := arg ? #defaultValue
2147
3579ce76c8c8 comment
Claus Gittinger <cg@exept.de>
parents: 2136
diff changeset
  7008
2148
f0a95dd96db5 comment
Claus Gittinger <cg@exept.de>
parents: 2147
diff changeset
  7009
      Note: this method should never be redefined in classes other than UndefinedObject.
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7010
      Notice:
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7011
         This method is open coded (inlined) by the compiler(s)
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7012
         - redefining it may not work as expected."
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7013
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7014
    ^ self
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7015
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7016
    "
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7017
     1 ? #default
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7018
     nil ? #default
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7019
    "
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7020
3465
1ba2cd91b1b5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3464
diff changeset
  7021
    "Created: / 4.11.1996 / 20:36:19 / cg"
1ba2cd91b1b5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3464
diff changeset
  7022
    "Modified: / 19.5.1998 / 17:39:56 / cg"
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7023
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7024
3463
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7025
?? defaultValue
3465
1ba2cd91b1b5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3464
diff changeset
  7026
     "a syntactic shugar-piece:
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7027
      much like ?, but sends #value to the argument if required.
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7028
      (i.e. its the same as #ifNil:)
3463
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7029
      If the receiver is nil, return the defaultValues value;
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7030
      otherwise, return the receiver.
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7031
      This method is only redefined in UndefinedObject - therefore,
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7032
      the recevier is retuned here.
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7033
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7034
      Thus, if foo and bar are simple variables or constants,
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7035
          foo ?? bar
3463
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7036
      is the same as:
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7037
          (foo isNil ifTrue:[bar value] ifFalse:[foo])
3463
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7038
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7039
      if they are message sends, the equivalent code is:
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7040
          [
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7041
              |t t2|
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7042
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7043
              t := foo.
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7044
              t isNil ifTrue:[bar value] ifFalse:[t]
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7045
          ] value
3463
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7046
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7047
      Can be used to provide defaultValues to variables,
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7048
      as in:
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7049
          foo := arg ?? [ self computeDefault ]
3463
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7050
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7051
      Note: this method should never be redefined in classes other than UndefinedObject.
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7052
     "
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7053
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7054
    ^ self
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7055
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7056
    "
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7057
     1 ?? #default 
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7058
     nil ?? #default
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7059
     1 ?? [ self halt. 1 + 2 ] 
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7060
     nil ?? [ self halt. 1 + 2 ] 
3463
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7061
    "
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7062
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7063
    "Created: / 4.11.1996 / 20:36:19 / cg"
3466
f0ba47c6d90a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3465
diff changeset
  7064
    "Modified: / 19.5.1998 / 17:42:56 / cg"
3463
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7065
!
2df184db7eef added ?? - much like ?, but sends #value to its argument.
Claus Gittinger <cg@exept.de>
parents: 3450
diff changeset
  7066
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7067
ifNil:aBlockOrValue
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7068
    "return myself, or the result from evaluating the argument, if I am nil.
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7069
     This is much like #?, but sends #value to the argument in case of a nil
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7070
     receiver.
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7071
     Notice:
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7072
        This method is open coded (inlined) by the compiler(s)
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7073
        - redefining it may not work as expected."
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7074
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7075
    ^ self
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7076
!
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7077
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7078
ifNil:nilBlockOrValue ifNotNil:notNilBlockOrValue
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7079
    "return the value of the first arg, if I am nil,
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7080
     the result from evaluating the 2nd argument, if I am not nil.
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7081
     Notice:
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7082
        This method is open coded (inlined) by the compiler(s)
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7083
        - redefining it may not work as expected."
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7084
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7085
    ^ notNilBlockOrValue value
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7086
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7087
!
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7088
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7089
ifNotNil:aBlockOrValue
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7090
    "return myself if nil, or the result from evaluating the argument, 
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7091
     if I am not nil.
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7092
     Notice:
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7093
        This method is open coded (inlined) by the compiler(s)
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7094
        - redefining it may not work as expected."
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7095
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7096
    ^ aBlockOrValue value
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7097
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7098
!
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7099
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7100
ifNotNil:notNilBlockOrValue ifNil:nilBlockOrValue
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7101
    "return the value of the 2nd arg, if I am nil,
4360
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7102
     the result from evaluating the 1st argument, if I am not nil.
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7103
     Notice:
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7104
        This method is open coded (inlined) by the compiler(s)
41671bce2bd6 comments only
Claus Gittinger <cg@exept.de>
parents: 4339
diff changeset
  7105
        - redefining it may not work as expected."
4339
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7106
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7107
    ^ notNilBlockOrValue value
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7108
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7109
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7110
!
18c19912a67c added #ifNil and friends - squeak compatibility.
Claus Gittinger <cg@exept.de>
parents: 4322
diff changeset
  7111
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7112
isArray
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7113
    "return true, if the receiver is some kind of array (or weakArray etc);
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7114
     false is returned here - the method is only redefined in Array."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7115
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7116
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7117
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7118
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7119
isAssociation
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7120
    "return true, if the receiver is some kind of association;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7121
     false is returned here - the method is only redefined in Association."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7122
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7123
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7124
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7125
    "Created: 14.5.1996 / 17:03:45 / cg"
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7126
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7127
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7128
isBehavior
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7129
    "return true, if the receiver is some kind of class (i.e. behavior);
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7130
     false is returned here - the method is only redefined in Behavior."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7131
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7132
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7133
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7134
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7135
isBlock
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7136
    "return true, if the receiver is some kind of block;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7137
     false returned here - the method is only redefined in Block."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7138
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7139
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7140
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7141
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7142
isByteArray
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7143
    "return true, if the receiver is some kind of bytearray;
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7144
     false is returned here - the method is only redefined in ByteArray."
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7145
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7146
    ^ false
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7147
!
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7148
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7149
isCharacter
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7150
    "return true, if the receiver is some kind of character;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7151
     false is returned here - the method is only redefined in Character."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7152
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7153
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7154
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7155
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7156
isClass
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7157
    "return true, if the receiver is some kind of class (real class, 
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7158
     not just behavior);
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7159
     false is returned here - the method is only redefined in Class."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7160
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7161
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7162
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7163
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7164
isCollection
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7165
    "return true, if the receiver is some kind of collection;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7166
     false is returned here - the method is only redefined in Collection."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7167
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7168
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7169
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7170
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7171
isColor
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7172
    "return true, if the receiver is some kind of color;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7173
     false is returned here - the method is only redefined in Color."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7174
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7175
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7176
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7177
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7178
isContext
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7179
    "return true, if the receiver is some kind of context;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7180
     false returned here - the method is only redefined in Context."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7181
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7182
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7183
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7184
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7185
isExternalStream
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7186
    "return true, if the receiver is some kind of externalStream;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7187
     false is returned here - the method is only redefined in ExternalStream."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7188
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7189
    ^false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7190
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7191
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7192
isFileStream
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7193
    "return true, if the receiver is some kind of fileStream;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7194
     false is returned here - the method is only redefined in FileStream."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7195
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7196
    ^false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7197
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7198
1887
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7199
isFixedPoint
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7200
    "return true, if the receiver is some kind of fixedPoint number;
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7201
     false is returned here - the method is only redefined in FixedPoint."
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7202
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7203
    ^ false
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7204
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7205
    "Created: 5.11.1996 / 19:23:04 / cg"
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7206
!
364cff2aec4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1867
diff changeset
  7207
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7208
isFixedSize
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7209
    "return true if the receiver cannot grow easily 
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7210
     (i.e. a grow may be expensive, since it involves a become:)"
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7211
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7212
    ^ true
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7213
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7214
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7215
isForm
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7216
    "return true, if the receiver is some kind of form;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7217
     false is returned here - the method is only redefined in Form."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7218
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7219
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7220
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7221
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7222
isFraction
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7223
    "return true, if the receiver is some kind of fraction;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7224
     false is returned here - the method is only redefined in Fraction."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7225
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7226
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7227
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7228
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7229
isImage
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7230
    "return true, if the receiver is some kind of image;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7231
     false is returned here - the method is only redefined in Image."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7232
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7233
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7234
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7235
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7236
isImageOrForm
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7237
    "return true, if the receiver is some kind of image or form;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7238
     false is returned here - the method is only redefined in Image and Form."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7239
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7240
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7241
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7242
2673
f514189f6096 added #isImmediate for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2655
diff changeset
  7243
isImmediate
4666
912683a1af94 comments
Claus Gittinger <cg@exept.de>
parents: 4664
diff changeset
  7244
    "return true if I am an immediate object
912683a1af94 comments
Claus Gittinger <cg@exept.de>
parents: 4664
diff changeset
  7245
     i.e. I am represented in the pointer itself and
912683a1af94 comments
Claus Gittinger <cg@exept.de>
parents: 4664
diff changeset
  7246
     no real object header/storage is used me.
912683a1af94 comments
Claus Gittinger <cg@exept.de>
parents: 4664
diff changeset
  7247
     (currently, only SmallIntegers and nil return true)"
2673
f514189f6096 added #isImmediate for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2655
diff changeset
  7248
f514189f6096 added #isImmediate for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2655
diff changeset
  7249
    ^ self class hasImmediateInstances
f514189f6096 added #isImmediate for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2655
diff changeset
  7250
f514189f6096 added #isImmediate for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2655
diff changeset
  7251
    "Created: 3.6.1997 / 12:00:18 / cg"
f514189f6096 added #isImmediate for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2655
diff changeset
  7252
!
f514189f6096 added #isImmediate for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2655
diff changeset
  7253
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7254
isInteger
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7255
    "return true, if the receiver is some kind of integer number;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7256
     false is returned here - the method is only redefined in Integer."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7257
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7258
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7259
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7260
2502
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7261
isJavaClass
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7262
    "return true, if this is a javaClass.
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7263
     false is returned here - the method is only redefined in JavaClass."
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7264
2502
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7265
    ^ false
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7266
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7267
    "Created: / 26.3.1997 / 13:34:54 / cg"
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7268
    "Modified: / 8.5.1998 / 21:25:21 / cg"
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7269
!
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7270
5149
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7271
isJavaClassRef
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7272
    "return true, if this is a JavaClassRef.
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7273
     false is returned here - the method is only redefined in JavaClassRef."
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7274
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7275
    ^ false
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7276
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7277
    "Modified: / 8.5.1998 / 21:25:46 / cg"
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7278
    "Created: / 24.12.1999 / 01:46:28 / cg"
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7279
!
0da06a139105 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5130
diff changeset
  7280
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7281
isJavaContext
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7282
    "return true, if this is a javaContext.
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7283
     false is returned here - the method is only redefined in JavaContext."
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7284
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7285
    ^ false
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7286
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7287
    "Created: / 8.5.1998 / 21:24:27 / cg"
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7288
    "Modified: / 8.5.1998 / 21:25:35 / cg"
2502
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7289
!
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7290
4816
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7291
isJavaMethod
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7292
    "return true, if this is a JavaMethod.
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7293
     false is returned here - the method is only redefined in JavaMethod."
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7294
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7295
    ^ false
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7296
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7297
    "Modified: / 8.5.1998 / 21:25:46 / cg"
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7298
    "Created: / 25.9.1999 / 23:26:12 / cg"
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7299
!
34d541d3fedd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4815
diff changeset
  7300
5129
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7301
isJavaMethodRef
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7302
    "return true, if this is a JavaMethodRef.
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7303
     false is returned here - the method is only redefined in JavaMethodRef."
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7304
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7305
    ^ false
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7306
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7307
    "Modified: / 8.5.1998 / 21:25:46 / cg"
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7308
    "Created: / 23.12.1999 / 19:44:51 / cg"
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7309
!
dc82dcd6825d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5085
diff changeset
  7310
2502
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7311
isJavaObject
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7312
    "return true, if this is a javaObject.
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7313
     false is returned here - the method is only redefined in JavaObject."
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7314
2502
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7315
    ^ false
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7316
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7317
    "Created: / 26.3.1997 / 13:34:48 / cg"
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7318
    "Modified: / 8.5.1998 / 21:25:46 / cg"
2502
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7319
!
8f3bf6043968 added #isJavaObject & #isJavaClass
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
  7320
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7321
isKindOf:aClass
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7322
    "return true, if the receiver is an instance of aClass or one of its
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7323
     subclasses, false otherwise.
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7324
     Advice: 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7325
        use of this to check objects for certain attributes/protocoll should
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7326
        be avoided; it limits the reusability of your classes by limiting use
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7327
        to instances of certain classes and fences you into a specific inheritance 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7328
        hierarchy.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7329
        Use check-methods to check an object for a certain attributes/protocol
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7330
        (such as #isXXXX, #respondsTo: or #isNumber).
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7331
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7332
        Using #isKindOf: is considered BAD STYLE.
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7333
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7334
     Advice2:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7335
        Be aware, that using an #isXXX method is usually much faster than 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7336
        using #isKindOf:; because isKindOf: has to walk up all the superclass 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7337
        hierarchy, comparing every class on the way. 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7338
        Due to caching in the VM, a call to #isXXX is normally reached via
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7339
        a single function call.
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7340
     "
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7341
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7342
%{  /* NOCONTEXT */
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7343
    register OBJ thisClass;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7344
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7345
    thisClass = __Class(self);
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7346
    while (thisClass != nil) {
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7347
        if (thisClass == aClass) {
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7348
            RETURN ( true );
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7349
        }
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7350
        thisClass = __ClassInstPtr(thisClass)->c_superclass;
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7351
    }
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  7352
    RETURN ( false );
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7353
%}
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  7354
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7355
"/
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7356
"/  the above code is equivalent to:
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7357
"/
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7358
"/  thisClass := self class.
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7359
"/  [thisClass notNil] whileTrue:[
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7360
"/      thisClass == aClass ifTrue:[^ true].
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7361
"/      thisClass := thisClass superclass
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  7362
"/  ].
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  7363
"/  ^ false
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7364
"/
5421
6dda4984b524 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5418
diff changeset
  7365
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7366
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7367
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7368
isLayout
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7369
    "return true, if the receiver is some kind of layout;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7370
     false is returned here - the method is only redefined in Layout."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7371
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7372
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7373
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7374
5252
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7375
isList
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7376
    "return true, if the receiver is some kind of list collection;
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7377
     false is returned here - the method is only redefined in List."
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7378
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7379
    ^ false
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7380
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7381
    "Created: / 11.2.2000 / 01:37:05 / cg"
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7382
!
6d3c2db1daa5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5195
diff changeset
  7383
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7384
isLiteral
4666
912683a1af94 comments
Claus Gittinger <cg@exept.de>
parents: 4664
diff changeset
  7385
    "return true, if the receiver can be represented as a literal constant in ST syntax;
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7386
     false is returned here - the method is redefined in some classes."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7387
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7388
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7389
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7390
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7391
isMemberOf:aClass
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7392
    "return true, if the receiver is an instance of aClass, false otherwise.
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7393
     Advice: 
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7394
        use of this to check objects for certain attributes/protocoll should
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7395
        be avoided; it limits the reusability of your classes by limiting use
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7396
        to instances of a certain class.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7397
        Use check-methods to check an object for a certain attributes/protocol
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7398
        (such as #isXXX, #respondsTo: or #isNumber);
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7399
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7400
        Using #isMemberOf: is considered BAD STYLE.
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3023
diff changeset
  7401
     Notice:
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7402
        This method is open coded (inlined) by the compiler(s)
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7403
        - redefining it may not work as expected."
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7404
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7405
    ^ (self class) == aClass
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7406
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7407
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7408
isMeta
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7409
    "return true, if the receiver is some kind of metaclass;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7410
     false is returned here - the method is only redefined in Metaclass."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7411
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7412
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7413
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7414
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7415
isMethod
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7416
    "return true, if the receiver is some kind of method;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7417
     false returned here - the method is only redefined in Method."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7418
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7419
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7420
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7421
4992
357cfb1de045 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4991
diff changeset
  7422
isMorph
357cfb1de045 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4991
diff changeset
  7423
    "return true, if the receiver is some kind of morph;
357cfb1de045 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4991
diff changeset
  7424
     false is returned here - the method is only redefined in Morph."
357cfb1de045 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4991
diff changeset
  7425
357cfb1de045 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4991
diff changeset
  7426
    ^ false
357cfb1de045 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4991
diff changeset
  7427
!
357cfb1de045 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4991
diff changeset
  7428
5327
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7429
isNameSpace
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7430
    "return true, if this is a nameSpace.
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7431
     false is returned here - the method is only redefined in Namespace."
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7432
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7433
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7434
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7435
    "Created: / 11.10.1996 / 18:08:56 / cg"
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7436
    "Modified: / 8.5.1998 / 21:26:05 / cg"
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7437
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7438
5327
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7439
isNamespace
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7440
    "return true, if this is a nameSpace.
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7441
     false is returned here - the method is only redefined in Namespace."
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7442
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7443
    self obsoleteMethodWarning:'use #isNameSpace'.
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7444
    ^ false
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7445
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7446
!
5e5602d156fa #isNamespace renamed to #isNameSpace
Claus Gittinger <cg@exept.de>
parents: 5307
diff changeset
  7447
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7448
isNumber
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7449
    "return true, if the receiver is some kind of number;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7450
     false is returned here - the method is only redefined in Number."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7451
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7452
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7453
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7454
5402
d3cd213d13ec test for class
ps
parents: 5367
diff changeset
  7455
isOrderedCollection
d3cd213d13ec test for class
ps
parents: 5367
diff changeset
  7456
    "return true, if the receiver is some kind of ordered collection (or list etc);
d3cd213d13ec test for class
ps
parents: 5367
diff changeset
  7457
     false is returned here - the method is only redefined in OrderedCollection."
d3cd213d13ec test for class
ps
parents: 5367
diff changeset
  7458
d3cd213d13ec test for class
ps
parents: 5367
diff changeset
  7459
    ^ false
d3cd213d13ec test for class
ps
parents: 5367
diff changeset
  7460
!
d3cd213d13ec test for class
ps
parents: 5367
diff changeset
  7461
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7462
isPoint
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7463
    "return true, if the receiver is some kind of point;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7464
     false is returned here - the method is only redefined in Point."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7465
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7466
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7467
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7468
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7469
isReal
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7470
    "return true, if the receiver is some kind of real number;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7471
     false is returned here - the method is only redefined in LimitedPrecisionReal."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7472
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7473
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7474
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7475
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7476
isRectangle
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7477
    "return true, if the receiver is some kind of rectangle;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7478
     false is returned here - the method is only redefined in Rectangle."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7479
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7480
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7481
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7482
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7483
isRemoteObject
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7484
    "return true, if the receiver is some kind of remoteObject,
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7485
     false if its local - the method is only redefined in RemoteObject."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7486
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7487
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7488
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7489
    "Created: 28.10.1996 / 15:18:45 / cg"
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7490
    "Modified: 28.10.1996 / 15:20:57 / cg"
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7491
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7492
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7493
isSequenceable
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7494
    "return true, if the receiver is some kind of sequenceable collection;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7495
     false is returned here - the method is only redefined in SequenceableCollection."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7496
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7497
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7498
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7499
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7500
isSequenceableCollection
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7501
    "OBSOLETE: use isSequenceable for ST-80 compatibility.
4007
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7502
     This method is a historic leftover and will be removed soon ...
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7503
     (although its name is much better than #isSequenceable - sigh)"
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7504
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7505
    self obsoleteMethodWarning:'use #isSequenceable'.
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7506
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7507
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7508
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7509
isSignal
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7510
    "return true, if the receiver is some kind of signal;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7511
     false returned here - the method is only redefined in Signal."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7512
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7513
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7514
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7515
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7516
isStream
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7517
    "return true, if the receiver is some kind of stream;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7518
     false is returned here - the method is only redefined in Stream."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7519
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7520
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7521
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7522
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7523
isString
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7524
    "return true, if the receiver is some kind of string;
4683
58f7ae8b2e44 comment
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  7525
     false is returned here - the method is only redefined in CharacterArray."
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7526
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7527
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7528
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7529
4007
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7530
isStringCollection
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7531
    "return true, if the receiver is some kind of stringCollection;
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7532
     false is returned here - the method is only redefined in StringCollection."
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7533
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7534
    ^ false
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7535
!
561d175af944 added #isStringCollection
Claus Gittinger <cg@exept.de>
parents: 3999
diff changeset
  7536
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7537
isSymbol
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7538
    "return true, if the receiver is some kind of symbol;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7539
     false is returned here - the method is only redefined in Symbol."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7540
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7541
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7542
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7543
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7544
isText
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7545
    "return true, if the receiver is some kind of text object;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7546
     false is returned here - the method is only redefined in Text."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7547
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7548
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7549
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7550
    "Created: 12.5.1996 / 10:56:50 / cg"
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7551
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7552
4009
15be251e3a47 added #isValueModel
Claus Gittinger <cg@exept.de>
parents: 4007
diff changeset
  7553
isValueModel
15be251e3a47 added #isValueModel
Claus Gittinger <cg@exept.de>
parents: 4007
diff changeset
  7554
    "return true, if the receiver is some kind of valueModel;
15be251e3a47 added #isValueModel
Claus Gittinger <cg@exept.de>
parents: 4007
diff changeset
  7555
     false is returned here - the method is only redefined in ValueModel."
15be251e3a47 added #isValueModel
Claus Gittinger <cg@exept.de>
parents: 4007
diff changeset
  7556
15be251e3a47 added #isValueModel
Claus Gittinger <cg@exept.de>
parents: 4007
diff changeset
  7557
    ^ false
15be251e3a47 added #isValueModel
Claus Gittinger <cg@exept.de>
parents: 4007
diff changeset
  7558
15be251e3a47 added #isValueModel
Claus Gittinger <cg@exept.de>
parents: 4007
diff changeset
  7559
!
15be251e3a47 added #isValueModel
Claus Gittinger <cg@exept.de>
parents: 4007
diff changeset
  7560
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7561
isVariable
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7562
    "return true if the receiver has indexed instance variables,
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7563
     false otherwise."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7564
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7565
    ^ self class isVariable
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7566
!
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7567
2704
3f56a3a9908a more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 2689
diff changeset
  7568
isVariableBinding
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7569
    "return true, if this is a binding for a variable.
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7570
     false is returned here - the method is only redefined in Binding."
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7571
2704
3f56a3a9908a more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 2689
diff changeset
  7572
    ^ false
3f56a3a9908a more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 2689
diff changeset
  7573
3436
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7574
    "Created: / 19.6.1997 / 17:38:44 / cg"
1a80952e6619 added #isJavaContext and some comments.
Claus Gittinger <cg@exept.de>
parents: 3423
diff changeset
  7575
    "Modified: / 8.5.1998 / 21:26:55 / cg"
2704
3f56a3a9908a more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 2689
diff changeset
  7576
!
3f56a3a9908a more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 2689
diff changeset
  7577
1867
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7578
isView
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7579
    "return true, if the receiver is some kind of view;
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7580
     false is returned here - the method is only redefined in View."
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7581
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7582
    ^ false
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7583
! !
e92d90126094 added ?;
Claus Gittinger <cg@exept.de>
parents: 1831
diff changeset
  7584
4664
925daae9ba0c Add traceInto:level:
Stefan Vogel <sv@exept.de>
parents: 4634
diff changeset
  7585
!Object methodsFor:'tracing'!
925daae9ba0c Add traceInto:level:
Stefan Vogel <sv@exept.de>
parents: 4634
diff changeset
  7586
4682
4158042a9c8c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4666
diff changeset
  7587
traceInto:aRequestor level:level from:referrer
4664
925daae9ba0c Add traceInto:level:
Stefan Vogel <sv@exept.de>
parents: 4634
diff changeset
  7588
    "double dispatch into tracer, passing my type implicitely in the selector"
925daae9ba0c Add traceInto:level:
Stefan Vogel <sv@exept.de>
parents: 4634
diff changeset
  7589
4682
4158042a9c8c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4666
diff changeset
  7590
    ^ aRequestor traceObject:self level:level from:referrer
4664
925daae9ba0c Add traceInto:level:
Stefan Vogel <sv@exept.de>
parents: 4634
diff changeset
  7591
925daae9ba0c Add traceInto:level:
Stefan Vogel <sv@exept.de>
parents: 4634
diff changeset
  7592
    "Created: / 2.9.1999 / 09:05:17 / stefan"
925daae9ba0c Add traceInto:level:
Stefan Vogel <sv@exept.de>
parents: 4634
diff changeset
  7593
! !
925daae9ba0c Add traceInto:level:
Stefan Vogel <sv@exept.de>
parents: 4634
diff changeset
  7594
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7595
!Object methodsFor:'user interaction & notifications'!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7596
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7597
activityNotification:aString
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7598
    "this can be sent from deeply nested methods, which are going to perform
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7599
     some long-time activity.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7600
     If there is a handler for the ActivityNotificationSignal signal, that one is raised,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7601
     passing the argument. The handler should show this message whereever it likes,
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7602
     and proceed. If there is no handler, this is simply ignored.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7603
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7604
     This is very useful to pass busy messages up to some higher level (typically a view)
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7605
     which likes to display that message in its label or a busy-box.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7606
     It could also be put into some logfile or printed on the standard output/error."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7607
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7608
    ActivityNotificationSignal isHandled ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7609
        ^ ActivityNotificationSignal raiseRequestWith:self errorString:aString
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7610
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7611
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7612
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7613
     nil activityNotification:'hello there'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7614
     self activityNotification:'hello there'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7615
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7616
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7617
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7618
     ActivityNotificationSignal handle:[:ex |
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7619
        ex errorString printNL.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7620
        ex proceed.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7621
     ] do:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7622
        'hello' printNL.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7623
        self activityNotification:'doing some long time computation'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7624
        'world' printNL.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7625
     ]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7626
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7627
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7628
    "Modified: 16.12.1995 / 18:23:42 / cg"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7629
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7630
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7631
confirm:aString
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7632
    "launch a confirmer, which allows user to enter yes or no.
5084
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7633
     return true for yes, false for no.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7634
     If no GUI is present (headless applications), true is returned."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7635
925
020a15fa450f use less memory for single-dependencies;
Claus Gittinger <cg@exept.de>
parents: 899
diff changeset
  7636
    "
020a15fa450f use less memory for single-dependencies;
Claus Gittinger <cg@exept.de>
parents: 899
diff changeset
  7637
     on systems without GUI, or during startup, output a message
020a15fa450f use less memory for single-dependencies;
Claus Gittinger <cg@exept.de>
parents: 899
diff changeset
  7638
     and return true (as if yes was answered)
020a15fa450f use less memory for single-dependencies;
Claus Gittinger <cg@exept.de>
parents: 899
diff changeset
  7639
     Q: should we ask user by reading Stdin ?
020a15fa450f use less memory for single-dependencies;
Claus Gittinger <cg@exept.de>
parents: 899
diff changeset
  7640
    "
020a15fa450f use less memory for single-dependencies;
Claus Gittinger <cg@exept.de>
parents: 899
diff changeset
  7641
    Smalltalk isInitialized ifFalse:[
5082
211f9c06656c oops - confirm/notify where wrong in the non-gui case
Claus Gittinger <cg@exept.de>
parents: 5081
diff changeset
  7642
        '*** confirmation requested during initialization:' errorPrintCR. 
211f9c06656c oops - confirm/notify where wrong in the non-gui case
Claus Gittinger <cg@exept.de>
parents: 5081
diff changeset
  7643
        aString errorPrintCR.
211f9c06656c oops - confirm/notify where wrong in the non-gui case
Claus Gittinger <cg@exept.de>
parents: 5081
diff changeset
  7644
        '*** I''ll continue, assuming <yes> ...' errorPrintCR.
5081
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7645
        ^ true
925
020a15fa450f use less memory for single-dependencies;
Claus Gittinger <cg@exept.de>
parents: 899
diff changeset
  7646
    ].
020a15fa450f use less memory for single-dependencies;
Claus Gittinger <cg@exept.de>
parents: 899
diff changeset
  7647
5081
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7648
    (Dialog isNil 
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7649
    or:[Screen isNil
5195
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7650
    or:[Screen current isNil
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7651
    or:[Screen current isOpen not]]]) ifTrue:[       
5082
211f9c06656c oops - confirm/notify where wrong in the non-gui case
Claus Gittinger <cg@exept.de>
parents: 5081
diff changeset
  7652
        'confirm: ' infoPrint.
211f9c06656c oops - confirm/notify where wrong in the non-gui case
Claus Gittinger <cg@exept.de>
parents: 5081
diff changeset
  7653
        aString infoPrintCR.
211f9c06656c oops - confirm/notify where wrong in the non-gui case
Claus Gittinger <cg@exept.de>
parents: 5081
diff changeset
  7654
        'continue, assuming <yes>' infoPrintCR.
5081
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7655
        ^ true
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7656
    ].
5082
211f9c06656c oops - confirm/notify where wrong in the non-gui case
Claus Gittinger <cg@exept.de>
parents: 5081
diff changeset
  7657
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7658
    Dialog autoload.        "in case its autoloaded"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7659
    ^ Dialog confirm:aString
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7660
        
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7661
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7662
     nil confirm:'hello'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7663
     self confirm:'hello'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7664
    "
1417
59e7d3c1df6d showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
  7665
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  7666
    "Modified: 20.5.1996 / 10:28:40 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7667
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7668
5367
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7669
confirm:aString orCancel:cancelBlock
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7670
    "launch a confirmer, which allows user to enter yes, no or cancel.
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7671
     return true for yes, false for no, or the value from cancelBlock for cancel.
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7672
     If no GUI is present (headless applications), cancelBlock is returned."
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7673
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7674
    |answer|
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7675
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7676
    answer := self confirmWithCancel:aString.
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7677
    answer isNil ifTrue:[
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7678
        ^ cancelBlock value
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7679
    ].
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7680
    ^ answer
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7681
        
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7682
    "
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7683
     self confirm:'hello' orCancel:[self halt]
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7684
    "
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7685
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7686
    "Modified: 20.5.1996 / 10:28:40 / cg"
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7687
!
76120309ae8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5356
diff changeset
  7688
5084
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7689
confirmWithCancel:aString
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7690
    "launch a confirmer, which allows user to enter yes, no or cancel.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7691
     return true for yes, false for no, nil for cancel.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7692
     If no GUI is present (headless applications), nil is returned."
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7693
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7694
    "
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7695
     on systems without GUI, or during startup, output a message
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7696
     and return true (as if yes was answered)
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7697
     Q: should we ask user by reading Stdin ?
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7698
    "
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7699
    Smalltalk isInitialized ifFalse:[
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7700
        '*** confirmation requested during initialization:' errorPrintCR. 
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7701
        aString errorPrintCR.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7702
        '*** I''ll continue, assuming <cancel> ...' errorPrintCR.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7703
        ^ nil
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7704
    ].
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7705
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7706
    (Dialog isNil 
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7707
    or:[Screen isNil
5195
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7708
    or:[Screen current isNil
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7709
    or:[Screen current isOpen not]]]) ifTrue:[       
5084
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7710
        'confirm: ' infoPrint.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7711
        aString infoPrintCR.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7712
        'continue, assuming <cancel>' infoPrintCR.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7713
        ^ nil
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7714
    ].
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7715
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7716
    Dialog autoload.        "in case its autoloaded"
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7717
    ^ Dialog confirmWithCancel:aString
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7718
        
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7719
    "
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7720
     nil confirmWithCancel:'hello' 
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7721
     self confirmWithCancel:'hello'
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7722
    "
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7723
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7724
    "Modified: 20.5.1996 / 10:28:40 / cg"
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7725
!
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7726
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7727
errorNotify:aString
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7728
    "launch a Notifier, showing top stack, telling user something
2150
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7729
     and give user a chance to enter debugger."
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7730
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7731
    ^ self
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7732
        errorNotify:aString 
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7733
        from:thisContext sender
2150
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7734
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7735
    "
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7736
     nil errorNotify:'hello there'
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7737
     self errorNotify:'hello there'
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7738
    "
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7739
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7740
    "Modified: 11.1.1997 / 18:39:20 / cg"
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7741
!
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7742
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7743
errorNotify:aString from:aContext
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7744
    "launch a Notifier, showing top stack (above aContext), 
3daace4e5fbc checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2148
diff changeset
  7745
     telling user something and give user a chance to enter debugger."
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7746
3766
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7747
    ^ self errorNotify:aString from:aContext allowDebug:true
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7748
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7749
    "Modified: / 17.8.1998 / 10:09:27 / cg"
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7750
!
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7751
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7752
errorNotify:aString from:aContext allowDebug:allowDebug
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7753
    "launch a Notifier, showing top stack (above aContext), 
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7754
     telling user something and optionally give the user a chance to enter debugger."
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7755
2082
36171caceb24 better errorNotify:
Claus Gittinger <cg@exept.de>
parents: 2043
diff changeset
  7756
    |info con sender action|
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7757
891
6807b8576453 handle warnboxes during init
ah
parents: 889
diff changeset
  7758
    Smalltalk isInitialized ifFalse:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7759
        'errorNotification: ' print. aString printCR.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7760
        ^ self
891
6807b8576453 handle warnboxes during init
ah
parents: 889
diff changeset
  7761
    ].
5055
6d02262273a5 care for nil Display in #errorNotify:
Claus Gittinger <cg@exept.de>
parents: 4992
diff changeset
  7762
    (Dialog isNil 
6d02262273a5 care for nil Display in #errorNotify:
Claus Gittinger <cg@exept.de>
parents: 4992
diff changeset
  7763
    or:[Screen isNil
5195
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7764
    or:[Screen current isNil
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7765
    or:[Screen current isOpen not]]]) ifTrue:[       
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7766
        "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7767
         on systems without GUI, simply show
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7768
         the message on the Transcript and abort.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7769
        "
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7770
        Transcript showCR:aString.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7771
        AbortSignal raise.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7772
        ^ self
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7773
    ].
2203
5899dbf1b69c go directly into the debugger if an error occurs
Claus Gittinger <cg@exept.de>
parents: 2194
diff changeset
  7774
5899dbf1b69c go directly into the debugger if an error occurs
Claus Gittinger <cg@exept.de>
parents: 2194
diff changeset
  7775
    Processor activeProcessIsSystemProcess ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7776
        action := #debug.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7777
        sender := aContext.
2203
5899dbf1b69c go directly into the debugger if an error occurs
Claus Gittinger <cg@exept.de>
parents: 2194
diff changeset
  7778
    ] ifFalse:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7779
        Dialog autoload.        "in case its autoloaded"
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7780
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7781
        ErrorSignal handle:[:ex |
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7782
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7783
            "/ a recursive error - quickly enter debugger
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7784
            "/ this happened, when I corrupted the Dialog class ...
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7785
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7786
            ('Object [error]: ' , ex errorString , ' caught in errorNotification') errorPrintCR.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7787
            action := #debug.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7788
            ex return.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7789
        ] do:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7790
            sender := aContext.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7791
            sender isNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7792
                sender := thisContext sender.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7793
                "/
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7794
                "/ for your convenience: skip the emergencyHandler block
2203
5899dbf1b69c go directly into the debugger if an error occurs
Claus Gittinger <cg@exept.de>
parents: 2194
diff changeset
  7795
"/                sender isBlockContext ifTrue:[
5899dbf1b69c go directly into the debugger if an error occurs
Claus Gittinger <cg@exept.de>
parents: 2194
diff changeset
  7796
"/                    sender := sender sender
5899dbf1b69c go directly into the debugger if an error occurs
Claus Gittinger <cg@exept.de>
parents: 2194
diff changeset
  7797
"/                ].
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7798
            ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7799
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7800
            "/ skip intermediate (signal & exception) contexts
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7801
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7802
            DebugView notNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7803
                sender := DebugView interestingContextFrom:sender
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7804
            ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7805
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7806
            "/ show the first 5 contexts
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7807
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7808
            con := sender.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7809
            info := aString , Character cr asString , Character cr asString.
5194
262d8638d2ef *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5180
diff changeset
  7810
            1 to:15 do:[:n |
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7811
                con notNil ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7812
                    info := info , con printString , Character cr asString.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7813
                    con := con sender
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7814
                ]
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7815
            ].
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7816
5062
246b3b42534e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5055
diff changeset
  7817
            (allowDebug and:[Debugger notNil]) ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7818
                action := Dialog 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7819
                        choose:info 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7820
                        label:('Exception [' , Processor activeProcess nameOrId , ']')
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7821
                        labels:#('proceed' 'abort' 'debug')
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7822
                        values:#(#proceed #abort #debug)
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7823
                        default:#debug.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7824
            ] ifFalse:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7825
                action := Dialog 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7826
                        choose:info 
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7827
                        label:('Exception [' , Processor activeProcess nameOrId , ']')
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7828
                        labels:#('proceed' 'abort')
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7829
                        values:#(#proceed #abort)
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7830
                        default:#abort.
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7831
            ]
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7832
        ].
2082
36171caceb24 better errorNotify:
Claus Gittinger <cg@exept.de>
parents: 2043
diff changeset
  7833
    ].
36171caceb24 better errorNotify:
Claus Gittinger <cg@exept.de>
parents: 2043
diff changeset
  7834
36171caceb24 better errorNotify:
Claus Gittinger <cg@exept.de>
parents: 2043
diff changeset
  7835
    action == #debug ifTrue:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7836
        Debugger enter:sender withMessage:aString mayProceed:true
2082
36171caceb24 better errorNotify:
Claus Gittinger <cg@exept.de>
parents: 2043
diff changeset
  7837
    ] ifFalse:[
4535
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7838
        action == #abort ifTrue:[
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7839
            AbortSignal raise
aaed5f554d8b code cleanup - removed all obsolete debugger entry protocol
Claus Gittinger <cg@exept.de>
parents: 4529
diff changeset
  7840
        ]
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7841
    ]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7842
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7843
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7844
     nil errorNotify:'hello there'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7845
     self errorNotify:'hello there'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7846
    "
1417
59e7d3c1df6d showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
  7847
3766
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7848
    "Modified: / 8.2.1997 / 12:47:41 / cg"
f352e71081ed better errorNotify (debug-option supressable)
Claus Gittinger <cg@exept.de>
parents: 3694
diff changeset
  7849
    "Created: / 17.8.1998 / 10:09:26 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7850
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7851
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7852
information:aString
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7853
    "launch an InfoBox, telling user something. 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7854
     These info-boxes can be suppressed by handling the 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7855
     UserNotification- or InformationSignal and proceeding in the handler."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7856
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7857
    InformationSignal isHandled ifTrue:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7858
        ^ InformationSignal raiseRequestWith:self errorString:aString
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7859
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7860
    self notify:aString
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7861
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7862
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7863
     nil information:'hello there'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7864
     self information:'hello there'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7865
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7866
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7867
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7868
     InformationSignal handle:[:ex |
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7869
        'no box popped' printNL.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7870
        ex proceed.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7871
     ] do:[
5356
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7872
        'hello' printNL.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7873
        self information:'some info'.
5c8883c4f065 *** empty log message ***
ps
parents: 5354
diff changeset
  7874
        'world' printNL.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7875
     ]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7876
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7877
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7878
    "Modified: 24.11.1995 / 22:29:49 / cg"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7879
!
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7880
5084
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7881
notify:aString
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7882
    "launch a Notifier, telling user something.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7883
     Use #information: for ignorable messages."
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7884
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7885
    Smalltalk isInitialized ifFalse:[
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7886
        'information: ' print. aString printCR.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7887
        ^ self
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7888
    ].
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7889
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7890
    (Smalltalk isInitialized not
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7891
    or:[Dialog isNil
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7892
    or:[Screen isNil
5195
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7893
    or:[Screen current isNil
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7894
    or:[Screen current isOpen not]]]]) ifTrue:[
5084
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7895
        "
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7896
         on systems without GUI, simply show
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7897
         the message on the Transcript and abort.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7898
        "
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7899
        Transcript show:'notification: '; showCR:aString.
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7900
        ^ self
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7901
    ].
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7902
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7903
    Dialog autoload.        "in case its autoloaded"
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7904
    Dialog information:aString
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7905
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7906
    "
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7907
     nil notify:'hello there'
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7908
     self notify:'hello there'
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7909
    "
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7910
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7911
    "Modified: 20.5.1996 / 10:28:48 / cg"
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7912
!
0daca20f05d6 added confirmWithCancel
Claus Gittinger <cg@exept.de>
parents: 5083
diff changeset
  7913
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7914
warn:aString
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7915
    "launch a WarningBox, telling user something.
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7916
     These warn-boxes can be suppressed by handling the 
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7917
     UserNotification- or WarningSignal and proceeding in the handler."
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7918
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7919
    WarningSignal isHandled ifTrue:[
5081
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7920
        ^ WarningSignal raiseRequestWith:self errorString:aString
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7921
    ].
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7922
5082
211f9c06656c oops - confirm/notify where wrong in the non-gui case
Claus Gittinger <cg@exept.de>
parents: 5081
diff changeset
  7923
    (Smalltalk isInitialized not
5083
770f121b8569 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5082
diff changeset
  7924
    or:[Dialog isNil
5081
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7925
    or:[Screen isNil
5195
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7926
    or:[Screen current isNil
de5ab488050b Do not try to use an unconnected display
Stefan Vogel <sv@exept.de>
parents: 5194
diff changeset
  7927
    or:[Screen current isOpen not]]]]) ifTrue:[       
5081
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7928
        "
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7929
         on systems without GUI, simply show
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7930
         the message on the Transcript and abort.
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7931
        "
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7932
        Transcript show:'warning: '; showCR:aString.
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7933
        ^ self
891
6807b8576453 handle warnboxes during init
ah
parents: 889
diff changeset
  7934
    ].
6807b8576453 handle warnboxes during init
ah
parents: 889
diff changeset
  7935
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7936
    Dialog autoload.        "in case its autoloaded"
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7937
    Dialog warn:aString
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7938
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7939
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7940
     nil warn:'hello there'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7941
     self warn:'hello there'
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7942
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7943
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7944
    "
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7945
     WarningSignal handle:[:ex |
5081
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7946
        ex proceed.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7947
     ] do:[
5081
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7948
        'hello' printNL.
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7949
        self warn:'some info'.
7e8bd5012897 care for warning, notify and information when no Screen is present.
Claus Gittinger <cg@exept.de>
parents: 5062
diff changeset
  7950
        'world' printNL.
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7951
     ]
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7952
    "
1417
59e7d3c1df6d showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
  7953
1425
cb86edc25a3b printNL -> printCR
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
  7954
    "Modified: 20.5.1996 / 10:28:53 / cg"
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7955
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7956
1788
0c71ba975d34 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1780
diff changeset
  7957
!Object class methodsFor:'documentation'!
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7958
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7959
version
5424
3ffaef20cfd0 removeKey:ifAbsent:
Claus Gittinger <cg@exept.de>
parents: 5421
diff changeset
  7960
    ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.329 2000-06-26 13:43:03 cg Exp $'
783
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7961
! !
78a9b311241f added #activityNotification:
Claus Gittinger <cg@exept.de>
parents: 782
diff changeset
  7962
Object initialize!