Object.st
author Claus Gittinger <cg@exept.de>
Wed, 23 Aug 2006 16:06:59 +0200
changeset 9657 3fa7b94ff781
parent 9643 daf683976e1e
child 9694 64f6face84d5
permissions -rw-r--r--
boss stuff separated
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
     1
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
     2
 COPYRIGHT (c) 1988 by Claus Gittinger
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
     3
              All Rights Reserved
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
     4
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
     5
 This software is furnished under a license and may be used
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
     6
 only in accordance with the terms of that license and with the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
     8
 be provided or otherwise made available to, or used by, any
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
     9
 other person.  No title to or ownership of the software is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    10
 hereby transferred.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    11
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    12
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    13
"{ Package: 'stx:libbasic' }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    14
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    15
nil subclass:#Object
6697
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    16
	instanceVariableNames:''
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    17
	classVariableNames:'ErrorSignal HaltSignal MessageNotUnderstoodSignal
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    18
		UserInterruptSignal RecursionInterruptSignal
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    19
		ExceptionInterruptSignal SubscriptOutOfBoundsSignal
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    20
		IndexNotFoundSignal NonIntegerIndexSignal NotFoundSignal
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    21
		KeyNotFoundSignal ElementOutOfBoundsSignal UserNotificationSignal
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    22
		InformationSignal WarningSignal PrimitiveFailureSignal
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    23
		DeepCopyErrorSignal AbortSignal ErrorRecursion Dependencies
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    24
		InfoPrinting ActivityNotificationSignal InternalErrorSignal
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    25
		NonWeakDependencies SynchronizationSemaphores ObjectAttributes
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    26
		OSSignalInterruptSignal FinalizationLobby
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    27
		RecursiveStoreStringSignal AbortAllSignal'
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    28
	poolDictionaries:''
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
    29
	category:'Kernel-Objects'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    30
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    31
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    32
!Object class methodsFor:'documentation'!
3023
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
    33
5754
333aba8041c2 checkin from browser
tm
parents: 5706
diff changeset
    34
copyright
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    35
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    36
 COPYRIGHT (c) 1988 by Claus Gittinger
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
    37
              All Rights Reserved
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    38
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    39
 This software is furnished under a license and may be used
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    40
 only in accordance with the terms of that license and with the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    41
 inclusion of the above copyright notice.   This software may not
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    42
 be provided or otherwise made available to, or used by, any
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    43
 other person.  No title to or ownership of the software is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    44
 hereby transferred.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    45
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    46
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    47
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    48
dependencies
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    49
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    50
   ST/X dependencies are slightly modified from ST-80's 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    51
   (we think they are better ;-).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    52
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    53
   One problem occuring very often in ST-80 is that some object
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    54
   cannot be garbage collected because some dependency is present,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    55
   having the object as a dependent of some other object.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    56
   In ST-80, this association remains alive (because a Dictionary
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    57
   is used to hold dependents) - even if no other references exist to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    58
   to dependent or the dependee.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    59
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    60
   This means, that in ST-80, a #release is mandatory in order to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    61
   prevent memory leaks.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    62
   We think, that this is a bad solution, since after all, exactly that
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    63
   kind of work should be performed by a garbage collector - you should not
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    64
   need to care about dependencies.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    65
   From a philosophical point of view, why should some object depend on 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    66
   something that the programmer considers a dead object ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    67
   (well - worse than that: it seems that some ST-80 code even depends on
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    68
    that behavior)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    69
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    70
   In order to limit the trouble, ST-80 reimplemented the way dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    71
   are stored in the model class - this one keeps the dependents locally,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    72
   so these dependents go away, once the model is reclaimed.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    73
   That may make things even more confusing: with models, no #release is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    74
   needed, with general objects it is mandatory.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    75
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    76
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    77
   In ST/X, dependencies are implemented using a WeakDictionary; this means,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    78
   that once the dependee dies, the dependency association is removed automatically,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    79
   and the dependent can be reclaimed by the garbage collector, if no other
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    80
   references exist to the dependent.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    81
   In order to (at least) provide a mechanism for the old behavior
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    82
   (in case your application heavily depends on the ST-80 mechanism), complementary
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    83
   protocol to add nonWeak dependencies is provided 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    84
   (see #addNonWeakDependent / #removeNonWeakDependent).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    85
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    86
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    87
   Caveat:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    88
      since interests are implemented using InterestConverter (which are simply
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    89
      forwarding messages), these must use the nonWeak mechanism (as done in ST-80
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    90
      automatically).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    91
      The reason is that there are usually no direct references to the converters,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    92
      and those would be reclaimed if stored in a weakDictionary.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    93
      This means, that those interests MUST be removed with #retractInterest
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    94
      (which is bug-compatible to ST-80). 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    95
      We rewrite things to provide a more convenient mechanism in the future ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    96
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    97
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    98
   I like to hear comments on the above - do you think its better ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    99
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   100
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   101
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   102
documentation
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   103
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   104
   Object is the superclass of most other classes. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   105
   (except for nil-subclasses, which inherit nothing,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   106
    to catch any message into their #doesNotUnderstand: method)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   107
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   108
   Protocol which is common to every object is defined here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   109
   Also some utility stuff (like notify) and error handling is implemented here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   110
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   111
   Object has no instance variables (and may not get any added). One reason is, that
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   112
   UndefinedObject and SmallInteger are also inheriting from Object - these two cannot 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   113
   have instance variables (due to their implementation). 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   114
   The other reason is that the runtime system (VM) knows about the layout of some built-in 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   115
   classes (think of Class, Method, Block and also Integer or Float). 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   116
   If you were allowed to add instance variables to Object, the VM had to be recompiled 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   117
   (and also rewritten in some places).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   118
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   119
   [Class variables:]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   120
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   121
        ErrorSignal     <Signal>        Signal raised for error/error: messages
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   122
                                        also, parent of all other signals.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   123
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   124
        HaltSignal      <Signal>        Signal raised for halt/halt: messages
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   125
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   126
        MessageNotUnderstoodSignal      Signals raised for various error conditions
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   127
        UserInterruptSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   128
        RecursionInterruptSignal 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   129
        ExceptionInterruptSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   130
        SubscriptOutOfBoundsSignal 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   131
        NonIntegerIndexSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   132
        NotFoundSignal 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   133
        KeyNotFoundSignal 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   134
        ElementOutOfBoundsSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   135
        InformationSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   136
        WarningSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   137
        DeepCopyErrorSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   138
        InternalErrorSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   139
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   140
        AbortSignal      <Signal>       Signal raised by debugger, to abort a computation
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   141
                                        BUT, the debugger will only raise it if it is handled.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   142
                                        By handling the abortSignal, you can control where the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   143
                                        debuggers abort-function resumes execution in case of
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   144
                                        an error.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   145
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   146
        ErrorRecursion   <Boolean>      controls behavior when recursive errors occur (i.e. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   147
                                        an error while handling an error).
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   148
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   149
        Dependencies     <WeakDependencyDictionary>  
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   150
                                        keeps track of object dependencies.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   151
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   152
        InfoPrinting     <Boolean>      controls weather informational messages 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   153
                                        are printed.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   154
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   155
        ActivityNotificationSignal <QuerySignal> 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   156
                                         raised on #activityNotification:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   157
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   158
        NonWeakDependencies <Dictionary> keeps track of object dependencies.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   159
                                         Dependents stay alive.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   160
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   161
        SynchronizationSemaphores <WeakIdentityDictionary>
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   162
                                         Semaphores for per-object-monitor.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   163
                                        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   164
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   165
    [author:]
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   166
        Claus Gittinger
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   167
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   168
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   169
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   170
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   171
!Object class methodsFor:'initialization'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   172
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   173
initSignals
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   174
    "called only once - initialize signals"
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   175
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   176
    ErrorSignal := Error.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   177
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   178
    ControlInterrupt notifierString:'control interrupted'.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   179
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   180
    HaltSignal := HaltInterrupt.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   181
    HaltSignal notifierString:'halt encountered'.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   182
5977
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   183
    MessageNotUnderstoodSignal := MessageNotUnderstood.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   184
    MessageNotUnderstoodSignal notifierString:'message not understood'.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   185
6000
d6fbafc5879e more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5995
diff changeset
   186
    PrimitiveFailureSignal := PrimitiveFailure.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   187
    PrimitiveFailureSignal notifierString:'primitive failed'.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   188
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   189
    InternalErrorSignal := VMInternalError.
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   190
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   191
    UserInterruptSignal := UserInterrupt.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   192
    UserInterruptSignal notifierString:'user Interrupt'.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   193
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   194
    RecursionInterruptSignal := RecursionError.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   195
    RecursionInterruptSignal notifierString:'recursion limit reached'.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   196
5977
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   197
    NotFoundSignal := NotFoundError.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   198
    NotFoundSignal notifierString:'no such element'.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   199
5977
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   200
    IndexNotFoundSignal := IndexNotFoundError.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   201
    IndexNotFoundSignal notifierString:'bad index: '.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   202
5977
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   203
    SubscriptOutOfBoundsSignal := SubscriptOutOfBoundsError.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   204
    SubscriptOutOfBoundsSignal notifierString:'subscript out of bounds: '.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   205
5977
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   206
    NonIntegerIndexSignal := NonIntegerIndexError.
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   207
    NonIntegerIndexSignal notifierString:'index must be integer'.
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   208
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   209
    KeyNotFoundSignal := KeyNotFoundError.
5977
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   210
    KeyNotFoundSignal notifierString:'no such key: '.
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   211
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   212
    ElementOutOfBoundsSignal := ElementBoundsError.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   213
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
   214
    UserNotificationSignal := UserNotification.
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
   215
    WarningSignal := Warning.
7035
1d049fb7ae5a Make UserInformation a class based exception
Stefan Vogel <sv@exept.de>
parents: 7033
diff changeset
   216
    InformationSignal := UserInformation.
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   217
    ActivityNotificationSignal := ActivityNotification.
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   218
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   219
    DeepCopyErrorSignal := DeepCopyError.
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   220
6203
d39d75849383 class based exceptions - abortSignal
Claus Gittinger <cg@exept.de>
parents: 6199
diff changeset
   221
    AbortSignal := AbortOperationRequest.
6877
ab4e7d42f9f8 AbortAllOperation - now class based
Claus Gittinger <cg@exept.de>
parents: 6874
diff changeset
   222
    AbortAllSignal := AbortAllOperationRequest.
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   223
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   224
    OSSignalInterruptSignal := OSSignalInterrupt.
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   225
    RecursiveStoreStringSignal := RecursiveStoreError.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   226
5980
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   227
    "
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   228
     Object initSignals
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   229
    "
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   230
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   231
    "Modified: / 22.1.1998 / 21:23:40 / av"
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   232
    "Modified: / 4.8.1999 / 08:54:06 / stefan"
6203
d39d75849383 class based exceptions - abortSignal
Claus Gittinger <cg@exept.de>
parents: 6199
diff changeset
   233
    "Modified: / 16.11.2001 / 16:30:08 / cg"
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   234
!
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   235
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   236
initialize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   237
    "called only once - initialize signals"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   238
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   239
    ErrorSignal isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   240
        self initSignals
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   241
    ].
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   242
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   243
    ObjectAttributes isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   244
        ObjectAttributes := WeakIdentityDictionary new.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   245
    ].
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   246
    Dependencies isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   247
        Dependencies := WeakDependencyDictionary new.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   248
    ].
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   249
    NonWeakDependencies isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   250
        NonWeakDependencies := IdentityDictionary new.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   251
    ].
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   252
    SynchronizationSemaphores isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   253
        SynchronizationSemaphores := WeakIdentityDictionary new.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   254
    ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   255
    FinalizationLobby isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   256
        FinalizationLobby := Registry new.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   257
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   258
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   259
    "/ initialize InfoPrinting to the VM's infoPrint setting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   260
    "/ (which can be turned off via a command line argument)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   261
    InfoPrinting := ObjectMemory infoPrinting.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   262
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   263
    "Object initialize"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   264
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   265
    "Modified: / 22.1.1998 / 21:23:40 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   266
    "Modified: / 3.2.1998 / 18:55:09 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   267
    "Modified: / 4.8.1999 / 08:54:06 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   268
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   269
7303
98111fb6a285 category
Claus Gittinger <cg@exept.de>
parents: 7285
diff changeset
   270
!Object class methodsFor:'Compatibility-ST80'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   271
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   272
rootError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   273
    "return the signal used for error/error: - handling.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   274
     Same as errorSignal for ST80 compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   275
7094
617eeaf2f8ba Convert Object>>errorSignal -> Error
Stefan Vogel <sv@exept.de>
parents: 7081
diff changeset
   276
    ^ Error
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   277
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   278
    "Created: / 15.1.1998 / 23:47:05 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   279
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   280
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   281
!Object class methodsFor:'Signal constants'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   282
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   283
abortAllSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   284
    "return the signal used to abort user actions (much like AbortSignal).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   285
     This signal is supposed to abort multiple operation actions, and get out of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   286
     the loop (such as when confirming multiple class deletions etc.)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   287
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   288
    ^ AbortAllSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   289
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   290
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   291
abortSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   292
    "return the signal used to abort user actions. This signal is only
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   293
     raised if caught (by the debugger), and will lead way out of the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   294
     currently active doIt/printIt or inspectIt. (also some others use
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   295
     this for a save abort)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   296
8521
60f0e479ffc1 use class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8502
diff changeset
   297
    ^ AbortOperationRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   298
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   299
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   300
activityNotificationSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   301
    "return the signal used for activity notifications.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   302
     A handler for this signal gets all #activityNotification: sends"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   303
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   304
    ^ ActivityNotification
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   305
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   306
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   307
deepCopyErrorSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   308
    "return the signal raised when a deepcopy is asked for
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   309
     an object which cannot do this (for example, BlockClosures
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   310
     or Contexts)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   311
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   312
    ^ DeepCopyError
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   313
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   314
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   315
elementOutOfBoundsSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   316
    "return the signal used for element error reporting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   317
     (this signal is used for example when a value not in 0..255 is to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   318
      be put into a bytearray)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   319
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   320
    ^ ElementBoundsError
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   321
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   322
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   323
errorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   324
    "return the signal used for error/error: - handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   325
7094
617eeaf2f8ba Convert Object>>errorSignal -> Error
Stefan Vogel <sv@exept.de>
parents: 7081
diff changeset
   326
    ^ Error
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   327
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   328
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   329
haltSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   330
    "return the signal used for halt/halt: - handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   331
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   332
    ^ HaltSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   333
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   334
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   335
indexNotFoundSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   336
    "return the signal used for bad index error reporting.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   337
     This is also the parentSignal of the nonIntegerIndex- and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   338
     subscriptOutOfBoundsSignal"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   339
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   340
    ^ IndexNotFoundSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   341
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   342
    "Created: / 8.11.1997 / 19:15:48 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   343
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   344
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   345
informationSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   346
    "return the signal used for informations. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   347
     A handler for this signal gets all #information: sends"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   348
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   349
    ^ InformationSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   350
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   351
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   352
internalErrorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   353
    "return the signal used to report internal (VM-) errors."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   354
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   355
    ^ VMInternalError
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   356
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   357
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   358
keyNotFoundSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   359
    "return the signal used for no such key error reporting"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   360
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   361
    ^ KeyNotFoundError
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   362
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   363
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   364
messageNotUnderstoodSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   365
    "return the signal used for doesNotUnderstand: - error handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   366
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   367
    ^ MessageNotUnderstoodSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   368
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   369
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   370
nonIntegerIndexSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   371
    "return the signal used for bad subscript error reporting"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   372
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   373
    ^ NonIntegerIndexSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   374
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   375
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   376
notFoundSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   377
    "return the signal used for no element found error reporting"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   378
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   379
    ^ NotFoundSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   380
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   381
7644
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   382
notifySignal
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   383
    "return the parent of all notification signals."
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   384
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   385
    ^ Notification
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   386
!
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   387
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   388
osSignalInterruptSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   389
    "return the signal used for OS-signal error reporting;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   390
     This is only raised if handled - otherwise, a debugger is entered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   391
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   392
    ^ OSSignalInterrupt
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   393
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   394
    "Modified: / 12.6.1998 / 16:27:26 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   395
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   396
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   397
primitiveFailureSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   398
    "return the signal used for primitiveFailed - error handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   399
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   400
    ^ PrimitiveFailure
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   401
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   402
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   403
privateMethodSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   404
    "return the signal used for privateMethod - error handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   405
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   406
    ^ MessageNotUnderstoodSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   407
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   408
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   409
recursionInterruptSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   410
    "return the signal used for recursion overflow error handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   411
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   412
    ^ RecursionInterruptSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   413
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   414
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   415
recursiveStoreStringSignal
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   416
    "return the notification used to report storeString generation of recursive objects"
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   417
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   418
    ^ RecursiveStoreError
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   419
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   420
    "
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   421
     RecursiveStoreError handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   422
        self halt
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   423
     ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   424
        |a|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   425
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   426
        a := Array new:1.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   427
        a at:1 put:a.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   428
        a storeOn:Transcript
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   429
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   430
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   431
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   432
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   433
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   434
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   435
     a := Array new:1.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   436
     a at:1 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   437
     a storeOn:Transcript
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   438
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   439
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   440
5980
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   441
subclassResponsibilitySignal
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   442
    "return the signal used for subclassResponsibility error reporting.
6652
4cfba8cb0652 typo and undo renaming of #/#cons:
Stefan Vogel <sv@exept.de>
parents: 6647
diff changeset
   443
     (this signal is used to signal incomplete subclasses - i.e. a programmers error)"
5980
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   444
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   445
    ^ SubclassResponsibilityError
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   446
!
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   447
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   448
subscriptOutOfBoundsSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   449
    "return the signal used for subscript error reporting.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   450
     (this signal is used for example when an array is accessed with an
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   451
      index less than 1 or greater than the array size)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   452
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   453
    ^ SubscriptOutOfBoundsSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   454
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   455
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   456
userInterruptSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   457
    "return the signal used for ^C interrupts handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   458
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   459
    ^ UserInterruptSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   460
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   461
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   462
userNotificationSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   463
    "the parent signal used with information and warnings.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   464
     Handling this allows handling of both information- and warning notifications."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   465
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   466
    ^ UserNotificationSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   467
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   468
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   469
warningSignal 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   470
    "return the signal used for warnings.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   471
     A handler for this signal gets all #warn: sends"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   472
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   473
    ^ WarningSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   474
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   475
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   476
!Object class methodsFor:'info messages'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   477
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   478
infoPrinting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   479
    "return the flag which controls information messages."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   480
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   481
    ^ InfoPrinting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   482
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   483
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   484
infoPrinting:aBoolean
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   485
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   486
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   487
    "turn on/off printing of information messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   488
     If the argument, aBoolean is false, infoPrint will not output
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   489
     messages. The default is true."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   490
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   491
    InfoPrinting := aBoolean
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   492
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   493
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   494
!Object class methodsFor:'queries'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   495
8892
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8879
diff changeset
   496
isAbstract
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8879
diff changeset
   497
    ^ self == Object
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8879
diff changeset
   498
!
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8879
diff changeset
   499
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   500
isBuiltInClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   501
    "return true, if this class is known by the run-time-system,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   502
     i.e. you cannot add/remove instance variables without recompiling
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   503
     the VM.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   504
     Here, true is returned for myself, false for subclasses."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   505
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   506
    ^ self == Object
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   507
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   508
    "Modified: 23.4.1996 / 16:00:07 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   509
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   510
8441
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   511
!Object methodsFor:'Compatibility-Dolphin'!
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   512
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   513
trigger:anAspect 
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   514
    self changed:anAspect
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   515
!
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   516
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   517
trigger:anAspect with:anArgument 
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   518
    self changed:anAspect with:anArgument
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   519
!
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   520
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   521
when:anAspect sendTo:anObject
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   522
    self expressInterestIn:anAspect for:anObject sendBack:anAspect
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   523
! !
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   524
9375
6cbc697095e7 Felix 6/15/2006
fm
parents: 9335
diff changeset
   525
!Object methodsFor:'Compatibility-ST/V'!
6cbc697095e7 Felix 6/15/2006
fm
parents: 9335
diff changeset
   526
6cbc697095e7 Felix 6/15/2006
fm
parents: 9335
diff changeset
   527
triggerEvent:aSymbol
6cbc697095e7 Felix 6/15/2006
fm
parents: 9335
diff changeset
   528
    self changed:aSymbol
6cbc697095e7 Felix 6/15/2006
fm
parents: 9335
diff changeset
   529
! !
6cbc697095e7 Felix 6/15/2006
fm
parents: 9335
diff changeset
   530
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7216
diff changeset
   531
!Object methodsFor:'Compatibility-ST80'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   532
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   533
isMetaclass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   534
    ^ self isMeta
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   535
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   536
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7216
diff changeset
   537
!Object methodsFor:'Compatibility-Squeak'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   538
6549
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   539
as:aSimilarClass
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   540
    "If the receivers class is not aSimilarClass,
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   541
     create and return an object of class aSimilarClass that has the same contents 
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   542
     as the receiver.
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   543
     Otherwise, return the receiver."
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   544
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   545
    self class == aSimilarClass ifTrue:[^ self].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   546
    ^ aSimilarClass newFrom:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   547
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   548
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   549
     #[1 2 3 4] as:ByteArray
6549
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   550
     #[1 2 3 4] as:Array
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   551
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   552
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   553
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   554
asString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   555
    ^ self printString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   556
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   557
9071
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   558
becomeForward:anotherObject
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   559
    self becomeSameAs:anotherObject
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   560
!
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   561
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   562
becomeForward:anotherObject copyHash:copyHash
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   563
    copyHash ifTrue:[ self error:'unsupported operation' ].
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   564
    self becomeSameAs:anotherObject
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   565
!
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   566
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   567
clone
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   568
    ^ self shallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   569
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   570
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   571
copyTwoLevel
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   572
    "one more level than a shallowCopy"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   573
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   574
    ^ self copyToLevel:2
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   575
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   576
    "
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   577
     |original copy elL1 elL2 elL3 copyOfElL1|
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   578
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   579
     original := Array new:3.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   580
     original at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   581
     original at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   582
     original at:3 put:(elL1 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   583
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   584
     elL1 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   585
     elL1 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   586
     elL1 at:3 put:(elL2 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   587
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   588
     elL2 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   589
     elL2 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   590
     elL2 at:3 put:(elL3 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   591
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   592
     elL3 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   593
     elL3 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   594
     elL3 at:3 put:(Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   595
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   596
     copy := original copyTwoLevel.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   597
     (original at:2) ~~ (copy at:2) ifFalse:[self halt].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   598
     (original at:3) ~~ (copy at:3) ifFalse:[self halt].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   599
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   600
     copyOfElL1 := copy at:3.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   601
     (elL1 at:2) == (copyOfElL1 at:2) ifFalse:[self halt].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   602
     (elL1 at:3) == (copyOfElL1 at:3) ifFalse:[self halt].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   603
    "
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   604
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   605
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   606
currentHand
5912
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   607
    "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."
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   608
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   609
    |w h|
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   610
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   611
    w := self currentWorld.
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   612
    h := w activeHand.
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   613
    h isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   614
        h := w hands first
5912
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   615
    ].
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   616
    ^ h
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   617
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   618
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   619
currentWorld
7159
7964c345d74c Object currentWorld - recursion if Utilities is unloaded
Claus Gittinger <cg@exept.de>
parents: 7121
diff changeset
   620
    Utilities autoload.    
7964c345d74c Object currentWorld - recursion if Utilities is unloaded
Claus Gittinger <cg@exept.de>
parents: 7121
diff changeset
   621
    ^ Utilities currentWorld
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   622
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   623
7320
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   624
explore
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   625
    (self confirm:'The Squeak explorer has not yet been ported to ST/X\\Inspect instead ?' withCRs)
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   626
    ifTrue:[
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   627
        self inspect
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   628
    ]
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   629
!
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   630
9335
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   631
isInMemory
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   632
    "All normal objects are."
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   633
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   634
    ^ true
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   635
!
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   636
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   637
newTileMorphRepresentative
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   638
        ^ TileMorph new setLiteral: self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   639
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   640
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   641
stringForReadout
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   642
        ^ self stringRepresentation
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   643
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   644
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   645
stringRepresentation
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   646
        "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"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   647
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   648
        ^ self printString 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   649
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   650
9146
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   651
valueWithPossibleArguments:argArray
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   652
     ^ self
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   653
!
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   654
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   655
veryDeepCopy
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
   656
     ^ self deepCopyUsing:(IdentityDictionary new)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   657
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   658
7567
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   659
!Object methodsFor:'Compatibility-VW'!
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   660
8637
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   661
isCharacters
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   662
    "added for visual works compatibility"
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   663
    ^ false
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   664
!
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   665
7567
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   666
keyNotFoundError:aKey
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   667
    "VW compatibility"
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   668
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   669
    self errorKeyNotFound:aKey.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   670
!
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   671
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   672
oneWayBecome:anotherObject
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   673
    ^ self becomeSameAs:anotherObject
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   674
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   675
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   676
     |arr o1 o2|
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   677
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   678
     arr := Array new:2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   679
     arr at:1 put:(o1 := Object new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   680
     arr at:2 put:(o2 := Point new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   681
     o1 oneWayBecome:o2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   682
     (arr at:1) ~~ o2 ifTrue:[self halt].
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   683
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   684
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   685
     |arr o1 o2|
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   686
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   687
     arr := Array new:2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   688
     arr at:1 put:(o1 := Object new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   689
     arr at:2 put:(o2 := Point new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   690
     o1 becomeSameAs:o2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   691
     (arr at:1) ~~ o2 ifTrue:[self halt].
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   692
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   693
! !
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   694
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   695
!Object methodsFor:'accessing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   696
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   697
at:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   698
    "return the indexed instance variable with index, anInteger;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   699
     this method can be redefined in subclasses."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   700
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   701
    ^ self basicAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   702
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   703
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   704
at:index put:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   705
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   706
     this method can be redefined in subclasses. Returns anObject (sigh)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   708
    ^ self basicAt:index put:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   709
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   710
    "Modified: 19.4.1996 / 11:13:29 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   711
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   712
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   713
basicAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   714
    "return the indexed instance variable with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   715
     Trigger an error if the receiver has no indexed instance variables.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   716
     This method should NOT be redefined in any subclass (except with great care, for tuning)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   717
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   718
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   719
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   720
    REGISTER int nbytes, indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   721
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   722
    REGISTER char *pFirst;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   723
    REGISTER int n;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   724
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   725
    /*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   726
     * notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   727
     * this can be done since basicAt: is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   728
     * and SmallInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   729
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   730
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   731
        myClass = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   732
        indx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   733
        n /* nInstVars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   734
        n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   735
        nbytes = __qSize(self) - n /* nInstBytes */;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   736
        pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   737
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   738
        switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   739
            case __MASKSMALLINT(POINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   740
            case __MASKSMALLINT(WKPOINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   741
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   742
                 * pointers
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   743
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   744
                if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   745
                    OBJ *op;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   746
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   747
                    op = (OBJ *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   748
                    RETURN ( *op );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   749
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   750
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   751
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   752
            case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   753
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   754
                 * (unsigned) bytes
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   755
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   756
                if ((unsigned)indx < nbytes) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   757
                    unsigned char *cp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   758
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   759
                    cp = (unsigned char *)pFirst + indx;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   760
                    RETURN ( __mkSmallInteger( (*cp & 0xFF)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   761
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   762
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   763
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   764
            case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   765
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   766
                 * native floats
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   767
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   768
                if ((unsigned)indx < (nbytes / sizeof(float))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   769
                    float *fp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   770
                    float f;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   771
                    OBJ v;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   772
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   773
                    fp = (float *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   774
                    f = *fp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   775
                    if (f == 0.0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   776
                        v = __float0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   777
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   778
                        __qMKSFLOAT(v, f);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   779
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   780
                    RETURN (v);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   781
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   782
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   783
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   784
            case __MASKSMALLINT(DOUBLEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   785
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   786
                 * native doubles
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   787
                 */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   788
#ifdef __NEED_DOUBLE_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   789
                if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   790
                    int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   791
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   792
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   793
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   794
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   795
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   796
                if ((unsigned)indx < (nbytes / sizeof(double))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   797
                    double *dp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   798
                    double d;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   799
                    OBJ v;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   800
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   801
                    dp = (double *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   802
                    d = *dp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   803
                    if (d == 0.0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   804
                        v = __float0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   805
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   806
                        __qMKFLOAT(v, d);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   807
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   808
                    RETURN (v);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   809
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   810
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   811
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   812
            case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   813
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   814
                 * unsigned 16bit ints
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   815
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   816
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   817
                 * it makes us independent of the short-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   818
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   819
                if ((unsigned)indx < (nbytes>>1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   820
                    unsigned short *sp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   821
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   822
                    sp = (unsigned short *)(pFirst + (indx<<1));
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   823
                    RETURN ( __mkSmallInteger( (*sp & 0xFFFF)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   824
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   825
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   826
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   827
            case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   828
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   829
                 * signed 16bit ints
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   830
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   831
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   832
                 * it makes us independent of the short-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   833
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   834
                if ((unsigned)indx < (nbytes>>1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   835
                    short *ssp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   836
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   837
                    ssp = (short *)(pFirst + (indx<<1));
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   838
                    RETURN ( __mkSmallInteger( (*ssp) ));
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   839
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   840
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   841
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   842
            case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   843
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   844
                 * unsigned 32bit ints
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   845
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   846
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   847
                 * it makes us independent of the int-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   848
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   849
                if ((unsigned)indx < (nbytes>>2)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   850
                    unsigned int32 ul;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   851
                    unsigned int32 *lp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   852
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   853
                    lp = (unsigned int32 *)(pFirst + (indx<<2));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   854
                    ul = *lp;
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8892
diff changeset
   855
#if __POINTER_SIZE__ == 8
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   856
                    {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   857
                        unsigned  INT ull = (unsigned INT)ul;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   858
                        RETURN ( __mkSmallInteger(ull) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   859
                    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   860
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   861
                    if (ul <= _MAX_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   862
                        RETURN ( __mkSmallInteger(ul) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   863
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   864
                    RETURN ( __MKULARGEINT(ul) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   865
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   866
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   867
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   868
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   869
            case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   870
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   871
                 * signed 32bit ints
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   872
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   873
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   874
                 * it makes us independent of the int-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   875
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   876
                if ((unsigned)indx < (nbytes>>2)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   877
                    int32 *slp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   878
                    int32 l;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   879
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   880
                    slp = (int32 *)(pFirst + (indx<<2));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   881
                    l = *slp;
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8892
diff changeset
   882
#if __POINTER_SIZE__ == 8
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   883
                    {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   884
                        INT ll = (INT)l;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   885
                        RETURN ( __mkSmallInteger(ll) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   886
                    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   887
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   888
                    if (__ISVALIDINTEGER(l)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   889
                        RETURN ( __mkSmallInteger(l) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   890
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   891
                    RETURN ( __MKLARGEINT(l) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   892
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   893
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   894
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   895
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   896
            case __MASKSMALLINT(SLONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   897
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   898
                 * signed 64bit longlongs
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   899
                 */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   900
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   901
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   902
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   903
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   904
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   905
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   906
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   907
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   908
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   909
                 * it makes us independent of the long/longlong-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   910
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   911
                if ((unsigned)indx < (nbytes>>3)) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8892
diff changeset
   912
#if __POINTER_SIZE__ == 8
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   913
                    INT *slp, ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   914
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   915
                    slp = (INT *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   916
                    ll = *slp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   917
                    if (__ISVALIDINTEGER(ll)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   918
                        RETURN ( __mkSmallInteger(ll) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   919
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   920
                    RETURN ( __MKLARGEINT(ll) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   921
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   922
                    __int64__ *llp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   923
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   924
                    llp = (__int64__ *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   925
                    RETURN (__MKINT64(llp));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   926
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   927
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   928
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   929
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   930
            case __MASKSMALLINT(LONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   931
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   932
                 * unsigned 64bit longlongs
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   933
                 */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   934
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   935
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   936
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   937
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   938
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   939
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   940
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   941
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   942
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   943
                 * it makes us independent of the long/longlong-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   944
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   945
                if ((unsigned)indx < (nbytes>>3)) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8892
diff changeset
   946
#if __POINTER_SIZE__ == 8
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   947
                    unsigned INT *ulp, ul;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   948
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   949
                    ulp = (unsigned INT *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   950
                    ul = *ulp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   951
                    if (ul <= _MAX_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   952
                        RETURN ( __mkSmallInteger(ul) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   953
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   954
                    RETURN ( __MKULARGEINT(ul) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   955
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   956
                    __uint64__ *llp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   957
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   958
                    llp = (__uint64__ *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   959
                    RETURN (__MKUINT64(llp));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   960
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   961
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   962
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   963
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   964
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   965
%}.
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
   966
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   967
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   968
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   969
basicAt:index put:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   970
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   971
     Returns anObject (sigh).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   972
     Trigger an error if the receiver has no indexed instance variables.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   973
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   974
     This method should NOT be redefined in any subclass (except with great care, for tuning)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   975
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   976
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   977
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   978
    register int nbytes, indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   979
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   980
    register char *pFirst;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   981
/*    int nInstBytes, ninstvars, flags; */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   982
    REGISTER int n;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   983
    unsigned int u;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   984
    int val;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   985
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   986
    /* notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   987
       this can be done since basicAt: is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   988
       and SmallInteger */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   989
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   990
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   991
        indx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   992
        myClass = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   993
        n /* ninstvars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   994
        n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   995
        nbytes = __qSize(self) - n /* nInstBytes */;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   996
        pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   997
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   998
        switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   999
            case __MASKSMALLINT(POINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1000
            case __MASKSMALLINT(WKPOINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1001
                if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1002
                    OBJ *op;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1003
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1004
                    op = (OBJ *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1005
                    *op = anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1006
                    __STORE(self, anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1007
                    RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1008
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1009
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1010
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1011
            case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1012
                if (__isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1013
                    val = __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1014
                    if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1015
                        if ((unsigned)indx < nbytes) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1016
                            char *cp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1017
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1018
                            cp = pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1019
                            *cp = val;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1020
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1021
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1022
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1023
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1024
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1025
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1026
            case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1027
                if ((unsigned)indx < (nbytes / sizeof(float))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1028
                    float *fp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1029
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1030
                    fp = (float *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1031
                    if (anObject != nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1032
                        if (! __isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1033
                            if (__qIsFloatLike(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1034
                                *fp = (float)(__floatVal(anObject));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1035
                                RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1036
                            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1037
                            if (__qIsShortFloat(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1038
                                *fp = __shortFloatVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1039
                                RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1040
                            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1041
                        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1042
                            *fp = (float) __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1043
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1044
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1045
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1046
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1047
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1048
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1049
            case __MASKSMALLINT(DOUBLEARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1050
#ifdef __NEED_DOUBLE_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1051
                if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1052
                    int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1053
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1054
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1055
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1056
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1057
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1058
                if ((unsigned)indx < (nbytes / sizeof(double))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1059
                    double *dp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1060
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1061
                    dp = (double *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1062
                    if (anObject != nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1063
                        if (! __isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1064
                            if (__qIsFloatLike(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1065
                                *dp = __floatVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1066
                                RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1067
                            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1068
                            if (__qIsShortFloat(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1069
                                *dp = (double)__shortFloatVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1070
                                RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1071
                            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1072
                        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1073
                            *dp = (double) __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1074
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1075
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1076
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1077
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1078
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1079
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1080
            case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1081
                if (__isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1082
                    val = __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1083
                    if ((unsigned)val <= 0xFFFF) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1084
                        if ((unsigned)indx < (nbytes>>1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1085
                            unsigned short *sp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1086
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1087
                            sp = (unsigned short *)(pFirst + (indx<<1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1088
                            *sp = val;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1089
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1090
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1091
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1092
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1093
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1094
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1095
            case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1096
                if (__isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1097
                    val = __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1098
                    if ((val >= -32768) && (val < 32768)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1099
                        if ((unsigned)indx < (nbytes>>1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1100
                            short *ssp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1101
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1102
                            ssp = (short *)(pFirst + (indx<<1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1103
                            *ssp = val;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1104
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1105
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1106
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1107
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1108
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1109
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1110
            case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1111
                if ((unsigned)indx < (nbytes>>2)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1112
                    int32 *slp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1113
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1114
                    slp = (int32 *)(pFirst + (indx<<2));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1115
                    if (__isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1116
                        *slp = __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1117
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1118
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1119
                    n = __signedLongIntVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1120
                    /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1121
                     * zero means failure for an int larger than 4 bytes 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1122
                     * (would be a smallInteger) 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1123
                     */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1124
                    if (n) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1125
                        *slp = n;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1126
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1127
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1128
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1129
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1130
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1131
            case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1132
                if ((unsigned)indx < (nbytes>>2)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1133
                    unsigned int32 *lp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1134
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1135
                    lp = (unsigned int32 *)(pFirst + (indx<<2));
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1136
                    if (anObject == __mkSmallInteger(0)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1137
                        *lp = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1138
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1139
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1140
                    u = __longIntVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1141
                    /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1142
                     * zero means failure for an int larger than 4 bytes
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1143
                     * (would be a smallInteger)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1144
                     */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1145
                    if (u) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1146
                        *lp = u;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1147
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1148
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1149
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1150
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1151
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1152
            case __MASKSMALLINT(SLONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1153
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1154
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1155
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1156
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1157
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1158
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1159
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1160
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1161
                if ((unsigned)indx < (nbytes>>3)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1162
                    __int64__ ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1163
                    __int64__ *sllp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1164
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1165
                    sllp = (__int64__ *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1166
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1167
                    if (anObject == __mkSmallInteger(0)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1168
                        ll.lo = ll.hi = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1169
                        *sllp = ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1170
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1171
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1172
                    if (__signedLong64IntVal(anObject, &ll)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1173
                        *sllp = ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1174
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1175
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1176
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1177
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1178
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1179
            case __MASKSMALLINT(LONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1180
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1181
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1182
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1183
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1184
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1185
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1186
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1187
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1188
                if ((unsigned)indx < (nbytes>>3)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1189
                    __uint64__ ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1190
                    __uint64__ *llp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1191
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1192
                    llp = (__uint64__ *)(pFirst + (indx<<3));
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1193
                    if (anObject == __mkSmallInteger(0)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1194
                        ll.lo = ll.hi = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1195
                        *llp = ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1196
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1197
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1198
                    if (__unsignedLong64IntVal(anObject, &ll)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1199
                        *llp = ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1200
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1201
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1202
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1203
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1204
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1205
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1206
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1207
    index isInteger ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1208
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1209
         the index should be an integer number
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1210
        "
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  1211
        ^ self indexNotInteger:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1212
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1213
    (index between:1 and:self size) ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1214
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1215
         the index is less than 1 or greater than the size of the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1216
         receiver collection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1217
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1218
        ^ self subscriptBoundsError:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1219
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1220
    (self class isFloatsOrDoubles) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1221
        anObject isNumber ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1222
            ^ self basicAt:index put:(anObject asFloat)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1223
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1224
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1225
    anObject isInteger ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1226
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1227
         the object to put into the receiver collection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1228
         should be an integer number
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1229
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1230
        ^ self elementNotInteger
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1231
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1232
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1233
     the object to put into the receiver collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1234
     is not an instance of the expected element class,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1235
     or the value is  not within the elements valid range.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1236
    "
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  1237
    ^ self elementBoundsError:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1238
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1239
    "Modified: 19.4.1996 / 11:14:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1240
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1241
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1242
byteAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1243
    "return the byte at index. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1244
     This is only allowed for non-pointer indexed objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1245
     (i.e. byteArrays, wordArrays, floatArrays etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1246
     The receivers indexed instvars are treated as an uninterpreted
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1247
     collection of bytes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1248
     Only useful with binary storage."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1249
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1250
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1251
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1252
    REGISTER int indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1253
    int nIndex;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1254
    REGISTER OBJ slf;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1255
    REGISTER OBJ cls;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1256
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1257
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1258
        slf = self;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1259
        if (__isNonNilObject(slf)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1260
            unsigned char *pFirst;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1261
            int nIndex;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1262
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1263
            cls = __qClass(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1264
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1265
            pFirst = __byteArrayVal(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1266
            pFirst += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1267
            nIndex = __byteArraySize(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1268
            indx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1269
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1270
            switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1271
                case __MASKSMALLINT(DOUBLEARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1272
#ifdef __NEED_DOUBLE_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1273
                    if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1274
                        int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1275
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1276
                        pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1277
                        nIndex -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1278
                    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1279
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1280
                    /* fall into */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1281
                case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1282
                case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1283
                case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1284
                case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1285
                case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1286
                case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1287
                    if ((unsigned)indx < (unsigned)nIndex) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1288
                        RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1289
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1290
                    break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1291
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1292
                case __MASKSMALLINT(LONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1293
                case __MASKSMALLINT(SLONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1294
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1295
                    if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1296
                        int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1297
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1298
                        pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1299
                        nIndex -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1300
                    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1301
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1302
                    if ((unsigned)indx < (unsigned)nIndex) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1303
                        RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1304
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1305
                    break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1306
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1307
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1308
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1309
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1310
    "/ index not integer or index out of range
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1311
    "/ or non-byte indexable receiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1312
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1313
    ^ self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1314
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1315
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1316
     Point new byteAt:1
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1317
     (ByteArray with:1 with:2) byteAt:2
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1318
     (WordArray with:1) byteAt:1       
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1319
     (FloatArray with:1.0) byteAt:2 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1320
     'hello' byteAt:1               
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1321
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1322
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1323
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1324
byteAt:index put:byteValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1325
    "set the byte at index. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1326
     This is only allowed for non-pointer indexed objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1327
     (i.e. byteArrays, wordArrays, floatArrays etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1328
     The receivers indexed instvars are treated as an uninterpreted
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1329
     collection of bytes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1330
     Only useful with binary storage."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1331
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1332
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1333
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1334
    REGISTER int indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1335
    int val, nIndex;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1336
    REGISTER OBJ slf;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1337
    REGISTER OBJ cls;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1338
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1339
    if (__bothSmallInteger(index, byteValue)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1340
        val = __intVal(byteValue);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1341
        if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1342
            slf = self;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1343
            if (__isNonNilObject(slf)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1344
                cls = __qClass(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1345
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1346
                indx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1347
                switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1348
                    case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1349
                    case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1350
                    case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1351
                    case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1352
                    case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1353
                    case __MASKSMALLINT(LONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1354
                    case __MASKSMALLINT(SLONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1355
                    case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1356
                    case __MASKSMALLINT(DOUBLEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1357
                        indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1358
                        nIndex = __byteArraySize(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1359
                        if ((unsigned)indx < (unsigned)nIndex) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1360
                            __ByteArrayInstPtr(slf)->ba_element[indx] = val;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1361
                            RETURN ( byteValue );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1362
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1363
                        break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1364
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1365
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1366
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1367
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1368
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1369
    "/ index not integer or index out of range
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1370
    "/ or non-byte indexable receiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1371
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1372
    ^ self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1373
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1374
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1375
     (ByteArray with:1 with:2) byteAt:2 put:3; yourself
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1376
     'hello' copy byteAt:1 put:105; yourself              
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1377
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1378
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1379
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1380
instVarAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1381
    "return a non-indexed instance variable;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1382
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1383
     - use with care (needed for copy, inspector etc.)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1384
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1385
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1386
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1387
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1388
    int idx, ninstvars;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1389
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1390
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1391
        myClass = __Class(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1392
        idx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1393
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1394
         * do not allow returning of non-object fields.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1395
         * if subclass did not make privisions for that,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1396
         * we wont do so here ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1397
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1398
        if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1399
            if (idx == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1400
                RETURN ( nil )
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1401
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1402
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1403
        ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1404
        if ((idx >= 0) && (idx < ninstvars)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1405
            RETURN ( __InstPtr(self)->i_instvars[idx] );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1406
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1407
    }
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1408
%}.
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1409
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1410
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1411
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1412
instVarAt:index put:value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1413
    "change a non-indexed instance variable;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1414
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1415
     - use with care (needed for copy, inspector etc.)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1416
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1417
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1418
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1419
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1420
    int idx, ninstvars;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1421
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1422
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1423
        myClass = __Class(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1424
        idx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1425
        ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1426
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1427
         * do not allow setting of non-object fields.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1428
         * if subclass did not make privisions for that,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1429
         * we wont do so here ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1430
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1431
        if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1432
            if (idx == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1433
                RETURN ( nil )
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1434
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1435
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1436
        if ((idx >= 0) && (idx < ninstvars)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1437
            __InstPtr(self)->i_instvars[idx] = value;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1438
            __STORE(self, value);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1439
            RETURN ( value );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1440
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1441
    }
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1442
%}.
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1443
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1444
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1445
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1446
instVarNamed:name 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1447
    "return a non-indexed instance variables value by name;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1448
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1449
     - use with care if at all (provided for inspectors and memory usage monitor).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1450
     Notice, this access is very slow (because the classes instVar-description has to be
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1451
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1452
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1453
    ^ self instVarAt:(self class instVarOffsetOf:name)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1454
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1455
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1456
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1457
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1458
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1459
     p := Point x:10 y:20.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1460
     p instVarNamed:'x'  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1461
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1462
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1463
    "Modified: 19.4.1996 / 11:12:39 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1464
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1465
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1466
instVarNamed:name ifAbsent:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1467
    "return a non-indexed instance variables value by name,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1468
     or the value of exceptionBlock, if there is no such instance variable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1469
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1470
     - use with care if at all (provided for inspectors and memory usage monitor).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1471
     Notice, this access is very slow (because the classes instVar-description has to be
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1472
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1473
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1474
    |idx|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1475
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1476
    idx := self class instVarOffsetOf:name.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1477
    idx isNil ifTrue:[^ exceptionBlock value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1478
    ^ self instVarAt:idx
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1479
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1480
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1481
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1482
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1483
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1484
     p := Point x:10 y:20.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1485
     p instVarNamed:'x'  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1486
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1487
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1488
    "Created: 6.7.1996 / 23:02:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1489
    "Modified: 6.7.1996 / 23:03:41 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1490
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1491
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1492
instVarNamed:name put:value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1493
    "set a non-indexed instance variable by name;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1494
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1495
     - if at all, use with care (provided for protocol completeness).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1496
     Notice, this access is very slow (because the classes instVar-description has to be
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1497
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1498
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1499
    ^ self instVarAt:(self class instVarOffsetOf:name) put:value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1500
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1501
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1502
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1503
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1504
     p := Point x:10 y:20.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1505
     p instVarNamed:'x' put:30.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1506
     p  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1507
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1508
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1509
    "Modified: 19.4.1996 / 11:12:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1510
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1511
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1512
!Object methodsFor:'attributes access'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1513
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1514
objectAttributeAt:attributeKey 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1515
    "return the attribute for a given key or nil if not found"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1516
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1517
    | attrs |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1518
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1519
    attrs := self objectAttributes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1520
    (attrs notNil and:[attrs size > 0]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1521
        ^ attrs at:attributeKey ifAbsent:[]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1522
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1523
    ^ nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1524
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1525
    "Created: / 22.1.1998 / 21:29:17 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1526
    "Modified: / 3.2.1998 / 18:55:55 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1527
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1528
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1529
objectAttributeAt:attributeKey put:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1530
    "store the attribute anObject referenced by key into the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1531
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1532
    "/ must do this save from interrupts, since the attributes collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1533
    "/ is possibly accessed from multiple threads ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1534
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1535
        | attrs |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1536
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1537
        attrs := self objectAttributes.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1538
        (attrs isNil or:[attrs size == 0]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1539
            attrs := WeakIdentityDictionary new.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1540
            attrs at:attributeKey put:anObject.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1541
            self objectAttributes:attrs.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1542
        ] ifFalse:[ 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1543
            attrs at:attributeKey put:anObject.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1544
        ].
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1545
    ] valueUninterruptably
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1546
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1547
    "Attaching additional attributes (slots) to an arbitrary object:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1548
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1549
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1550
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1551
     p := Point new.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1552
     p objectAttributeAt:#color put:#green.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1553
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1554
     p objectAttributeAt:#color
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1555
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1556
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1557
    "Created: / 22.1.1998 / 21:29:25 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1558
    "Modified: / 3.2.1998 / 18:57:58 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1559
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1560
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1561
objectAttributes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1562
    "return a Collection of attributes - nil if there is none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1563
     The default implementation here uses a global WeakDictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1564
     attributes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1565
     This may be too slow for high frequency slot access,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1566
     therefore, some classes may redefine this for better performance.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1567
     Notice the mentioning of a WeakDictionary - read the classes documentation."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1568
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1569
    ^ ObjectAttributes at:self ifAbsent:[nil]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1570
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1571
    "Created: / 22.1.1998 / 21:29:30 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1572
    "Modified: / 18.2.2000 / 11:34:16 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1573
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1574
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1575
objectAttributes:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1576
    "set the collection of attributes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1577
     The default implementation here uses a global Dictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1578
     attributes which may be too slow for high frequency change&update.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1579
     Therefore, some classes may redefine this for better performance."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1580
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1581
    "/ must do this save from interrupts, since the attributes collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1582
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1583
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1584
    (OperatingSystem blockInterrupts) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1585
        "/ the common case - already blocked
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1586
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1587
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1588
            ObjectAttributes removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1589
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1590
            ObjectAttributes at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1591
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1592
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1593
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1594
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1595
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1596
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1597
            ObjectAttributes removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1598
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1599
            ObjectAttributes at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1600
        ].
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  1601
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1602
        OperatingSystem unblockInterrupts
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1603
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1604
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1605
    "Created: / 22.1.1998 / 21:29:35 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1606
    "Modified: / 3.2.1998 / 18:58:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1607
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1608
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1609
removeObjectAttribute:attributeKey
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1610
    "make the argument, anObject be no attribute of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1611
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1612
    "/ must do this save from interrupts, since the attributes collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1613
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1614
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1615
        |attrs n a|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1616
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1617
        attrs := self objectAttributes.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1618
        attrs size == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1619
            self objectAttributes:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1620
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1621
            attrs removeKey:attributeKey ifAbsent:nil.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1622
            attrs size == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1623
                self objectAttributes:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1624
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1625
        ]
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1626
    ] valueUninterruptably
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1627
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1628
    "Created: / 22.1.1998 / 21:29:39 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1629
    "Modified: / 18.2.2000 / 11:32:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1630
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1631
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1632
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1633
!Object methodsFor:'change & update'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1634
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1635
broadcast:aSelectorSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1636
    "send a message with selector aSelectorSymbol to all my dependents"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1637
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1638
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1639
        dependent perform:aSelectorSymbol
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1640
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1641
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1642
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1643
broadcast:aSelectorSymbol with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1644
    "send a message with selector aSelectorSymbol with an additional
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1645
     argument anArgument to all my dependents."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1646
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1647
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1648
        dependent perform:aSelectorSymbol with:anArgument
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1649
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1650
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1651
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1652
changeRequest
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1653
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1654
     grant the request, and return true if so"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1655
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1656
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1657
        dependent updateRequest ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1658
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1659
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1660
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1661
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1662
changeRequest:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1663
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1664
     grant the request, and return true if so"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1665
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1666
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1667
        (dependent updateRequest:aParameter) ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1668
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1669
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1670
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1671
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1672
changeRequest:aParameter from:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1673
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1674
     except anObject grant the request, and return true if so.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1675
     The argument anObject is typically going to be the one who is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1676
     about to send the change request."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1677
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1678
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1679
        dependent == anObject ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1680
            (dependent updateRequest:aParameter) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1681
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1682
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1683
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1684
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1685
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1686
changeRequestFrom:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1687
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1688
     except anObject grant the request, and return true if so.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1689
     The argument anObject is typically going to be the one who is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1690
     about to send the change request."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1691
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1692
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1693
        dependent == anObject ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1694
            (dependent updateRequest) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1695
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1696
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1697
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1698
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1699
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1700
changed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1701
    "notify all dependents that the receiver has changed.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1702
     Each dependent gets a '#update:'-message with the original
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1703
     receiver as argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1704
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1705
    self changed:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1706
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1708
changed:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1709
    "notify all dependents that the receiver has changed somehow.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1710
     Each dependent gets a '#update:'-message with aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1711
     as argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1712
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1713
    self changed:aParameter with:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1714
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1715
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1716
changed:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1717
    "notify all dependents that the receiver has changed somehow.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1718
     Each dependent gets a  '#update:with:from:'-message, with aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1719
     and anArgument as arguments."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1720
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1721
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1722
        dependent update:aParameter with:anArgument from:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1723
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1724
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1725
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1726
update:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1727
    "the message is sent to a dependent, when one of the objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1728
     on whom the receiver depends, has changed. The argument aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1729
     is either the changed object or the argument to the #changed: message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1730
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1731
     Default behavior here is to do nothing"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1732
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1733
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1734
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1735
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1736
update:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1737
    "dependent is notified of some change -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1738
     Default is to try update:"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1739
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1740
    ^ self update:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1741
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1742
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1743
update:aParameter with:anArgument from:sender
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1744
    "dependent is notified of some change -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1745
     Default is to try update:with:"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1746
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1747
    ^ self update:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1748
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1749
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1750
updateRequest
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1751
    "return true, if an update request is granted.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1752
     Default here is to grant updates - may be used
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1753
     to lock updates if someone is making other changes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1754
     from within an update. Or if someone has locked its
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1755
     state and does not want others to change things.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1756
     However, these dependents must all honor the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1757
     changeRequest - ifTrue - change protocol. I.e. they
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1758
     must first ask all others via changeRequest, and only do the change
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1759
     it returns true. The others must decide in updateRequest and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1760
     return true if they think a change is ok."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1761
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1762
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1763
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1764
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1765
updateRequest:aSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1766
    "return true, if an update request is granted.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1767
     Default here a simple updateRequest"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1768
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1769
    ^ self updateRequest
7177
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1770
!
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1771
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1772
withoutUpdating:someone do:aBlock
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1773
    "evaluate a block but remove someone from my dependents temporarily"
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1774
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1775
    (self dependents includesIdentical:someone)
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1776
    ifFalse:[
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1777
        ^ aBlock value.
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1778
    ].
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1779
    self removeDependent:someone.
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  1780
    ^ aBlock ensure:[ self addDependent:someone ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1781
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1782
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1783
!Object methodsFor:'cleanup'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1784
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1785
lowSpaceCleanup
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1786
    "ignored here - redefined in some classes to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1787
     cleanup in low-memory situations"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1788
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1789
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1790
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1791
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1792
!Object methodsFor:'comparing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1793
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1794
= anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1795
    "return true, if the receiver and the arg have the same structure.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1796
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1797
        This method is partially open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1798
        identical objects are always considered equal.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1799
        redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1800
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1801
    ^ self == anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1802
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1803
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1804
== anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1805
    "return true, if the receiver and the arg are the same object.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1806
     Never redefine this in any class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1807
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1808
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1809
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1810
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1811
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1812
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1813
    RETURN ( (self == anObject) ? true : false );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1814
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1815
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1816
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1817
deepSameContentsAs:anObject
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1818
    "return true, if the receiver and the arg have the same contents
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1819
     in both the named instance vars and any indexed instVars.
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1820
     This method descends into referenced objects, where #sameContentsAs: does not descend"
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1821
5821
c11bb6c8cc8f Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5814
diff changeset
  1822
    |myClass val
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1823
     sz "{ Class: SmallInteger }" |
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1824
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1825
    myClass := self class.
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1826
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1827
        sz := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1828
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1829
        "compare the indexed variables"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1830
        1 to:sz do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1831
            val := self basicAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1832
            val isLiteral ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1833
                val = (anObject basicAt:i) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1834
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1835
                (val deepSameContentsAs:(anObject basicAt:i)) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1836
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1837
        ]
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1838
    ].
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1839
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1840
    "compare the instance variables"
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1841
    sz := myClass instSize.
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1842
    1 to:sz do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1843
        val := self instVarAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1844
        val isLiteral ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1845
            val = (anObject instVarAt:i) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1846
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1847
            (val deepSameContentsAs:(anObject instVarAt:i)) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1848
        ]
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1849
    ].
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1850
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1851
    ^ true
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1852
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1853
    "
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1854
     #(1 2 3 4) deepSameContentsAs:#[1 2 3 4] asArray 
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1855
     (1@2) deepSameContentsAs:(1->2)
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1856
    "
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1857
!
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  1858
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1859
hash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1860
    "return an Integer useful as a hash key for the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1861
     This hash should return same values for objects with same
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1862
     contents (i.e. use this to hash on structure)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1863
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1864
    ^ self identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1865
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1866
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1867
identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1868
    "return an Integer useful as a hash key for the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1869
     This hash should return same values for the same object (i.e. use
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1870
     this to hash on identity of objects).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1871
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1872
     We cannot use the Objects address (as other smalltalks do) since
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1873
     no object-table exists and the hashval must not change when objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1874
     are moved by the collector. Therefore we assign each object a unique
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1875
     Id in the object header itself as its hashed upon.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1876
     (luckily we have 11 bits spare to do this - unluckily its only 11 bits).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1877
     Time will show, if 11 bits are enough; if not, another entry in the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1878
     object header will be needed, adding 4 bytes to every object. Alternatively,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1879
     hashed-upon objects could add an instvar containing the hash value."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1880
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1881
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1882
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  1883
    REGISTER unsigned INT hash;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1884
    static unsigned nextHash = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1885
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1886
    if (__isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1887
        hash = __GET_HASH(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1888
        if (hash == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1889
            /* has no hash yet */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1890
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1891
            if (++nextHash > __MAX_HASH__) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1892
                nextHash = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1893
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1894
            hash = nextHash;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1895
            __SET_HASH(self, hash);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1896
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1897
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1898
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1899
         * now, we got 11 bits for hashing;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1900
         * make it as large as possible; since most hashers use the returned
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1901
         * key and take it modulo some prime number, this will allow for
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1902
         * better distribution (i.e. bigger empty spaces) in hashed collection.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1903
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1904
        hash = __MAKE_HASH__(hash);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1905
        RETURN ( __mkSmallInteger(hash) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1906
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1907
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1908
    ^ 0 "never reached, since redefined in UndefinedObject and SmallInteger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1909
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1910
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1911
identityHashForBinaryStore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1912
    "hash which is usable if the object does not change its class
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1913
     and does not #become something else, while the hash is used.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1914
     This is only used by the binary storage mechanism, during the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1915
     object writing phase."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1916
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1917
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1918
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  1919
    REGISTER unsigned INT hash, hash1, hash2, sz;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1920
    OBJ o;
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  1921
    static unsigned INT nextHash = 0;
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  1922
    static unsigned INT nextClassHash = 0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1923
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1924
    if (__isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1925
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1926
         * my own identityHash
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1927
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1928
        hash1 = __GET_HASH(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1929
        if (hash1 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1930
            /* has no hash yet */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1931
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1932
            if (++nextHash > __MAX_HASH__) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1933
                nextHash = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1934
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1935
            hash1 = nextHash;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1936
            __SET_HASH(self, hash1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1937
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1938
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1939
         * my classes identityHash
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1940
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1941
        o = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1942
        hash2 = __GET_HASH(o);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1943
        if (hash2 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1944
            /* has no hash yet */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1945
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1946
            if (++nextClassHash > __MAX_HASH__) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1947
                nextClassHash = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1948
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1949
            hash2 = nextClassHash;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1950
            __SET_HASH(o, hash2);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1951
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1952
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1953
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1954
         * some bits of my size
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1955
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1956
        sz = __qSize(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1957
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1958
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1959
         * now, we got 11 + 11 + 8 bits for hashing;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1960
         * make it as large as possible; since most hashers use the returned
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1961
         * key and take it modulo some prime number, this will allow for
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1962
         * better distribution (i.e. bigger empty spaces) in hashed collection.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1963
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1964
        hash = (hash1 << 11) | hash2;           /* 22 bits */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1965
        hash = (hash << 8) | (sz & 0xFC);       /* 30 bits */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1966
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1967
        while ((hash & 0x20000000) == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1968
            hash <<= 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1969
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1970
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1971
        RETURN ( __mkSmallInteger(hash) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1972
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1973
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1974
    "never reached, since UndefinedObject and SmallInteger are not hashed upon in binary storage"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1975
    ^ self identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1976
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1977
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1978
sameContentsAs:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1979
    "return true, if the receiver and the arg have the same contents
7121
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  1980
     in both the named instance vars and any indexed instVars.
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  1981
     The code here only checks if values present in the receiver are also
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  1982
     present in the arg, not vice versa.
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  1983
     I.e. the argument may be bigger and/or have more instance variables."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1984
5821
c11bb6c8cc8f Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5814
diff changeset
  1985
    |myClass
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1986
     sz "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1987
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1988
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1989
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1990
        sz := self basicSize.
7121
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  1991
        anObject basicSize >= sz ifFalse:[^ false].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1992
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1993
        "compare the indexed variables"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1994
        1 to:sz do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1995
            (self basicAt:i) == (anObject basicAt:i) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1996
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1997
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1998
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1999
    "compare the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2000
    sz := myClass instSize.
7121
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2001
    anObject instSize >= sz ifFalse:[^ false].
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2002
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2003
    1 to:sz do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2004
        (self instVarAt:i) == (anObject instVarAt:i) ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2005
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2006
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2007
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2008
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2009
    "
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2010
     #(1 2 3 4) sameContentsAs:#[1 2 3 4] asArray 
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2011
     (1@2) sameContentsAs:(1->2)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2012
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2013
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2014
    "Created: / 21.4.1998 / 15:56:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2015
    "Modified: / 21.4.1998 / 15:58:15 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2016
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2017
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2018
~= anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2019
    "return true, if the receiver and the arg do not have the same structure.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2020
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2021
        This method is partially open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2022
        identical objects are never considered unequal.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2023
        redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2024
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2025
    ^ (self = anObject) not
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2026
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2027
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2028
~~ anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2029
    "return true, if the receiver and the arg are not the same object.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2030
     Never redefine this in any class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2031
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2032
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2033
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2034
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2035
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2036
    RETURN ( (self == anObject) ? false : true );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2037
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2038
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2039
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2040
!Object methodsFor:'converting'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2041
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2042
-> anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2043
    "return an association with the receiver as key and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2044
     the argument as value"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2045
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2046
    ^ Association key:self value:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2047
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2048
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2049
asCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2050
    "return myself as a Collection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2051
     Redefined in collection to return themself."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2052
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2053
    ^ Array with:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2054
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2055
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2056
asSequenceableCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2057
    "return myself as a SequenceableCollection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2058
     Redefined in SequenceableCollection"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2059
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2060
    ^ Array with:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2061
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2062
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2063
asValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2064
    "return a valueHolder for for the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2065
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2066
    ^ ValueHolder with:self
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2067
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2068
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2069
collect
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2070
    "return mySelf"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2071
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2072
    ^ self
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2073
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2074
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2075
deepCollect
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2076
    "return mySelf"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2077
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2078
    ^ self
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2079
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2080
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2081
deepSelect
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2082
    "return mySelf"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2083
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2084
    ^ self
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2085
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2086
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2087
select
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2088
    "return mySelf"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2089
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2090
    ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2091
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2092
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2093
!Object methodsFor:'copying'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2094
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2095
cloneFrom:anObject 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2096
    "Helper for copy:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2097
     copy all instance variables from anObject into the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2098
     which should be of the same class as the argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2099
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2100
    self cloneFrom:anObject performing:#yourself
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2101
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2102
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2103
     |x|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2104
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2105
     x := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2106
     x cloneFrom:#(1 2 3).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2107
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2108
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2109
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2110
cloneFrom:anObject performing:aSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2111
    "Helper for copy:
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2112
     for each instance variable from anObject, send it aSymbol
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2113
     and store the result into the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2114
     which should be of the same class as the argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2115
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2116
    |myClass sz "{ Class: SmallInteger }" t |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2117
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2118
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2119
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2120
        sz := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2121
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2122
        "process the indexed instance variables"
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2123
        1 to:sz do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2124
            t := anObject basicAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2125
            aSymbol ~~ #yourself ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2126
                t := t perform:aSymbol.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2127
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2128
            self basicAt:i put:t.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2129
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2130
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2131
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2132
    "process the named instance variables"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2133
    sz := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2134
    1 to:sz do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2135
        t := anObject instVarAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2136
        aSymbol ~~ #yourself ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2137
            t := t perform:aSymbol
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2138
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2139
        self instVarAt:i put:t
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2140
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2141
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2142
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2143
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2144
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2145
cloneInstanceVariablesFrom:aPrototype
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2146
    "Shallow copy variables from a prototype into myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2147
     This copies instVars by name - i.e. same-named variables are
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2148
     copied, others are not.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2149
     The variable slots are copied as available 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2150
     (i.e. the min of both indexed sizes is used)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2151
        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2152
    |myInfo otherInfo|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2153
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2154
    myInfo := self class instanceVariableOffsets.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2155
    otherInfo := aPrototype class instanceVariableOffsets.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2156
    myInfo keysAndValuesDo:[:name :index | |varIndexAssoc|
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2157
        varIndexAssoc := otherInfo at:name ifAbsent:[].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2158
        varIndexAssoc notNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2159
            self instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2160
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2161
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2162
    self isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2163
        1 to:(self basicSize min:aPrototype basicSize) do:[:index |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2164
            self basicAt:index put:(aPrototype basicAt:index)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2165
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2166
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2167
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2168
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2169
     Class withoutUpdatingChangesDo:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2170
         Point subclass:#Point3D
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2171
           instanceVariableNames:'z'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2172
           classVariableNames:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2173
           poolDictionaries:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2174
           category:'testing'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2175
         (Point3D new cloneInstanceVariablesFrom:1@2) inspect.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2176
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2177
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2178
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2179
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2180
     Class withoutUpdatingChangesDo:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2181
         Point variableSubclass:#Point3D
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2182
           instanceVariableNames:'z'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2183
           classVariableNames:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2184
           poolDictionaries:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2185
           category:'testing'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2186
         ((Point3D new:2) cloneInstanceVariablesFrom:#(1 2 3)) inspect.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2187
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2188
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2189
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2190
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2191
     |someObject|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2192
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2193
     Class withoutUpdatingChangesDo:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2194
         Object subclass:#TestClass1 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2195
           instanceVariableNames:'foo bar'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2196
           classVariableNames:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2197
           poolDictionaries:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2198
           category:'testing'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2199
         someObject := TestClass1 new.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2200
         someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2201
         Object subclass:#TestClass2 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2202
           instanceVariableNames:'bar foo'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2203
           classVariableNames:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2204
           poolDictionaries:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2205
           category:'testing'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2206
         (TestClass2 new cloneInstanceVariablesFrom:someObject) inspect.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2207
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2208
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2209
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2210
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2211
     |top b b1|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2212
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2213
     top := StandardSystemView new.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2214
     top extent:100@100.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2215
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2216
     b := Button in:top.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2217
     b label:'hello'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2218
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2219
     b1 := ArrowButton new cloneInstanceVariablesFrom:b.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2220
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2221
     top open.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2222
     b1 inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2223
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2224
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2225
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2226
copy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2227
    "return a copy of the receiver - defaults to shallowcopy here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2228
     Notice, that copy does not copy dependents."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2229
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2230
    ^ self shallowCopy postCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2231
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2232
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2233
copyToLevel:level
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2234
    "a controlled deepCopy, where the number of levels can be specified.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2235
     Notice: 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2236
         This method DOES NOT handle cycles/self-refs and does NOT preserve object identity; 
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2237
         i.e. identical references in the source are copied multiple times into the copy."
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2238
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2239
    |newObject class index|
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2240
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2241
    level == 1 ifTrue:[^ self shallowCopy].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2242
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2243
    class := self class.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2244
    newObject := self clone.
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2245
    newObject == self ifTrue: [^ self].
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2246
    class isVariable ifTrue:[ 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2247
        index := self basicSize.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2248
        [index > 0] whileTrue:[
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2249
            newObject basicAt: index put: ((self basicAt: index) copyToLevel:(level-1)).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2250
            index := index - 1
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2251
        ]
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2252
    ].
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2253
    index := class instSize.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2254
    [index > 0] whileTrue:[
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2255
        newObject instVarAt: index put: ((self instVarAt: index) copyToLevel:(level-1)).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2256
        index := index - 1
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2257
    ].
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2258
    ^ newObject
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2259
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2260
    "
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2261
     |a b|
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2262
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2263
     a := #( 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2264
            '1.1' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2265
            '1.2' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2266
            '1.3'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2267
            ( 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2268
                '1.41' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2269
                '1.42' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2270
                '1.43'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2271
                    ( 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2272
                        '1.441' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2273
                        '1.442' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2274
                        '1.443'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2275
                        ( '1.4441' '1.4442' '1.4443' )
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2276
                        '1.445' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2277
                    )
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2278
                '1.45'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2279
            )
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2280
            '1.5'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2281
           ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2282
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2283
      b := a copyToLevel:1.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2284
      self assert: ( (a at:1) == (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2285
      self assert: ( (a at:4) == (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2286
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2287
      b := a copyToLevel:2.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2288
      self assert: ( (a at:1) ~~ (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2289
      self assert: ( (a at:4) ~~ (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2290
      self assert: ( ((a at:4) at:1) == ((b at:4) at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2291
      self assert: ( ((a at:4) at:4) == ((b at:4) at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2292
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2293
      b := a copyToLevel:3.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2294
      self assert: ( (a at:1) ~~ (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2295
      self assert: ( (a at:4) ~~ (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2296
      self assert: ( ((a at:4) at:1) ~~ ((b at:4) at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2297
      self assert: ( ((a at:4) at:4) ~~ ((b at:4) at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2298
      self assert: ( (((a at:4) at:4) at:1) == (((b at:4) at:4)at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2299
      self assert: ( (((a at:4) at:4) at:4) == (((b at:4) at:4)at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2300
    "
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2301
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2302
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2303
deepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2304
    "return a copy of the object with all subobjects also copied.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2305
     This method DOES handle cycles/self-refs and preserves object identity; 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2306
     however the receivers class is not copied (to avoid the 'total' copy).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2307
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2308
     This deepCopy is a bit slower than the old (unsecure) one, since it
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2309
     keeps track of already copied objects. If you are sure, that your
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2310
     copied object does not include duplicates (or you do not care) and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2311
     no cycles are involved, you can use the old simpleDeepCopy, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2312
     which avoids this overhead (but may run into trouble).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2313
     Notice, that deepCopy does not copy dependents."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2314
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2315
    ^ self deepCopyUsing:(IdentityDictionary new)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2316
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2317
    "an example which is not handled by the old deepCopy:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2318
    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2319
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2320
     a := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2321
     a at:3 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2322
     a deepCopy inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2323
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2324
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2325
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2326
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2327
     a := Color black onDevice:Screen current.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2328
     a deepCopy inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2329
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2330
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2331
    "Modified: 27.3.1996 / 16:31:20 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2332
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2333
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2334
deepCopyError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2335
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2336
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2337
    "raise a signal, that deepCopy is not allowed for this object"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2338
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  2339
    ^ DeepCopyError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2340
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2341
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2342
deepCopyUsing:aDictionary
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2343
    "a helper for deepCopy; return a copy of the object with 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2344
     all subobjects also copied. If the to-be-copied object is in the dictionary, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2345
     use the value found there. The class of the receiver is not copied.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2346
     This method DOES handle cycles/self references."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2347
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2348
    |myClass aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2349
     sz "{ Class: SmallInteger }" 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2350
     iOrig iCopy|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2351
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2352
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2353
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2354
        sz := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2355
        aCopy := myClass basicNew:sz.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2356
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2357
        sz := 0.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2358
        aCopy := myClass basicNew
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2359
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2360
    aCopy setHashFrom:self.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2361
    aDictionary at:self put:aCopy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2362
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2363
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2364
     copy indexed instvars - if any
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2365
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2366
    sz ~~ 0 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2367
        myClass isBits ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2368
            "block-copy indexed instvars"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2369
            aCopy replaceFrom:1 to:sz with:self startingAt:1
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2370
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2371
            "individual deep copy the indexed variables"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2372
            1 to:sz do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2373
                iOrig := self basicAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2374
                iOrig notNil ifTrue:[
8372
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2375
                    "/ used to be dict-includesKey-ifTrue[dict-at:], 
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2376
                    "/ changed to use dict-at:ifAbsent:, to avoid double lookup in dictionary
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2377
                    iCopy := aDictionary at:iOrig ifAbsent:nil.
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2378
                    iCopy isNil ifTrue:[
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2379
                        iCopy := iOrig deepCopyUsing:aDictionary
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2380
                    ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2381
                    aCopy basicAt:i put:iCopy
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2382
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2383
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2384
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2385
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2386
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2387
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2388
     copy the instance variables
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2389
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2390
    sz := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2391
    1 to:sz do:[:i |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2392
        (self skipInstvarIndexInDeepCopy:i) ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2393
            iOrig := self instVarAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2394
            iOrig notNil ifTrue:[
8372
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2395
                iCopy := aDictionary at:iOrig ifAbsent:nil.
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2396
                iCopy isNil ifTrue:[
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2397
                    iCopy := iOrig deepCopyUsing:aDictionary
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2398
                ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2399
                aCopy instVarAt:i put:iCopy
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2400
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2401
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2402
    ].
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2403
    aCopy postDeepCopyFrom:self.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2404
    ^ aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2405
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2406
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2407
     |a b c copyOfC|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2408
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2409
     a := Array with:'hello' with:'world' with:nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2410
     b := 99 @ 999.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2411
     a at:3 put:b.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2412
     c := Array with:a with:b with:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2413
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2414
     Transcript showCR: (c at:1) == (c at:3).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2415
     copyOfC := c deepCopy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2416
     Transcript showCR: (copyOfC at:1) == (copyOfC at:3)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2417
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2418
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2419
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2420
postCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2421
    "this is for compatibility with ST-80 code, which uses postCopy for
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2422
     cleanup after copying, while ST/X passes the original in postCopyFrom:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2423
     (see there)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2424
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2425
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2426
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2427
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2428
postDeepCopy
8930
edd42af66c0a deepCopy should not invoke postCopy
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2429
    "allows for cleanup after deep copying.
edd42af66c0a deepCopy should not invoke postCopy
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2430
     To be redefined in subclasses."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2431
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2432
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2433
postDeepCopyFrom:aSource
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2434
    "allows for cleanup after deep copying"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2435
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2436
    ^ self postDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2437
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2438
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2439
setHashFrom:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2440
    "set my identity-hash key to be the same as anObjects hash key. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2441
     This is an ST/X speciality, which is NOT available in other (especially OT based) 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2442
     Smalltalks, and may not be available in future ST/X versions.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2443
     DO NEVER use this for normal application code."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2444
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2445
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2446
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2447
    REGISTER unsigned h;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2448
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2449
    if (__isNonNilObject(self) && __isNonNilObject(anObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2450
        h = __GET_HASH(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2451
        __SET_HASH(self, h);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2452
        RETURN (self);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2453
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2454
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2455
    self primitiveFailed    "neither receiver not arg may be nil or SmallInteger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2456
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2457
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2458
shallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2459
    "return a copy of the object with shared subobjects (a shallow copy)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2460
     i.e. the copy shares referenced instvars with its original."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2461
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2462
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2463
    int ninsts, spc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2464
    int sz;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2465
    OBJ theCopy;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2466
    OBJ cls;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2467
    int flags;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2468
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2469
    cls = __qClass(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2470
    flags = __intVal(__ClassInstPtr(cls)->c_flags);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2471
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2472
    /*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2473
     * bail out for special objects ..
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2474
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2475
    if (((flags & ~ARRAYMASK) == 0)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2476
     && ((flags & ARRAYMASK) != WKPOINTERARRAY)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2477
        sz = __qSize(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2478
        __PROTECT__(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2479
        __qNew(theCopy, sz);    /* OBJECT ALLOCATION */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2480
        __UNPROTECT__(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2481
        if (theCopy) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2482
            cls = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2483
            spc = __qSpace(theCopy);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2484
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2485
            theCopy->o_class = cls; __STORE_SPC(theCopy, cls, spc);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2486
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2487
            sz = sz - OHDR_SIZE;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2488
            if (sz) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2489
                char *src, *dst;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2490
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2491
                src = (char *)(__InstPtr(self)->i_instvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2492
                dst = (char *)(__InstPtr(theCopy)->i_instvars);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2493
#ifdef bcopy4
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2494
                {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2495
                    /* care for odd-number of longs */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2496
                    int nW = sz >> 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2497
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2498
                    if (sz & 3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2499
                        nW++;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2500
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2501
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2502
                    bcopy4(src, dst, nW);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2503
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2504
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2505
                bcopy(src, dst, sz);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2506
#endif
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2507
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2508
                flags &= ARRAYMASK;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2509
                if (flags == POINTERARRAY) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2510
                    ninsts = __BYTES2OBJS__(sz);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2511
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2512
                    ninsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2513
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2514
                if (ninsts) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2515
                    do {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2516
                        OBJ el;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2517
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2518
                        el = __InstPtr(theCopy)->i_instvars[ninsts-1];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2519
                        __STORE_SPC(theCopy, el, spc);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2520
                    } while (--ninsts);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2521
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2522
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2523
            RETURN (theCopy);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2524
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2525
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2526
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2527
    "/ fallBack for special objects & memoryAllocation failure case
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2528
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2529
    ^ self slowShallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2530
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2531
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2532
simpleDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2533
    "return a copy of the object with all subobjects also copied.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2534
     This method does NOT handle cycles - but is included to allow this 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2535
     slightly faster copy in situations where it is known that
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2536
     no recursive references occur (LargeIntegers for example).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2537
     NOTICE: you will run into trouble, when trying this with recursive
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2538
     objects (usually recursionInterrupt or memory-alert).
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2539
     This method corresponds to the 'traditional' deepCopy found in the Blue book."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2540
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2541
    |myClass aCopy|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2542
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2543
    (myClass := self class) isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2544
        aCopy := myClass basicNew:(self basicSize).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2545
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2546
        aCopy := myClass basicNew
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2547
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2548
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2549
    "copy the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2550
    aCopy cloneFrom:self performing:#simpleDeepCopy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2551
    ^ aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2552
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2553
    "a bad example (but ST/X should survive ...)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2554
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2555
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2556
     a := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2557
     a at:3 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2558
     a simpleDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2559
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2560
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2561
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2562
skipInstvarIndexInDeepCopy:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2563
    "a helper for deepCopy; only indices for which this method returns
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2564
     false are copied in a deep copy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2565
     The default is false here - which means that everything is copied.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2566
     Can be redefined in subclasses for partial copies"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2567
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2568
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2569
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2570
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2571
slowShallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2572
    "return a copy of the object with shared subobjects (a shallow copy)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2573
     i.e. the copy shares referenced instvars with its original.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2574
     This method is only invoked as a fallback from #shallowCopy."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2575
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2576
    |myClass aCopy|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2577
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2578
    (myClass := self class) isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2579
        aCopy := myClass basicNew:(self basicSize).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2580
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2581
        aCopy := myClass basicNew
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2582
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2583
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2584
    "copy the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2585
    aCopy cloneFrom:self performing:#yourself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2586
    ^ aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2587
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2588
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2589
!Object methodsFor:'debugging'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2590
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2591
assert:aBooleanOrBlock
6964
a9ecdb3f1e52 comments
Claus Gittinger <cg@exept.de>
parents: 6963
diff changeset
  2592
    "fail, if the argument is not true and report an error"
a9ecdb3f1e52 comments
Claus Gittinger <cg@exept.de>
parents: 6963
diff changeset
  2593
8876
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2594
    aBooleanOrBlock == true ifTrue:[^ self].
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2595
    "/ could still be a block or false.
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2596
    self 
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2597
        assert:aBooleanOrBlock 
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2598
        message:('Assertion failed in ' , thisContext sender printString)
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2599
!
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2600
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2601
assert:aBooleanOrBlock message:messageIfFailing
6964
a9ecdb3f1e52 comments
Claus Gittinger <cg@exept.de>
parents: 6963
diff changeset
  2602
    "fail, if the argument is not true and report an error"
6961
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2603
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2604
    "{ Pragma: +optSpace }"
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2605
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2606
    (aBooleanOrBlock value) ifFalse:[
8273
72c29dfc55af may proceed for assert
penk
parents: 7983
diff changeset
  2607
        self error:messageIfFailing mayProceed:true
6961
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2608
    ].
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2609
!
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2610
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2611
basicInspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2612
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2613
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2614
    "launch an inspector on the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2615
     this method should NOT be redefined in subclasses."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2616
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2617
    Inspector isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2618
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2619
         for systems without GUI
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2620
        "
6926
72f1a7eb34f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6918
diff changeset
  2621
        self warn:'No Inspector defined (Inspector is nil).' 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2622
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2623
        Inspector openOn:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2624
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2625
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2626
    "Modified: 18.5.1996 / 15:43:25 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2627
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2628
6954
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2629
breakPoint:something
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2630
    "{ Pragma: +optSpace }"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2631
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2632
    "Like halt, but disabled by default.
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2633
     Can be easily enabled.
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2634
     Can be filtered on the arguments value (typically: a symbol).
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2635
     Code with breakpoints may be even checked into the source repository"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2636
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2637
    "Example:   nil breakPoint:#stefan"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2638
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2639
"/    something = OperatingSystem getLoginName ifTrue:[
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2640
"/        ^ HaltSignal raiseRequestWith:something errorString:'Breakpoint encountered: ', something printString
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2641
"/    ].
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2642
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2643
"/    something = 'testThis' ifTrue:[
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2644
"/        ^ HaltSignal raiseRequestWith:something errorString:'Breakpoint encountered: ', something printString
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2645
"/    ].
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2646
!
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2647
5995
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2648
browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2649
    "open a browser on the receivers class"
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2650
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2651
    self class theNonMetaclass browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2652
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2653
    "
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2654
     10 browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2655
     Collection browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2656
     Collection class browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2657
    "
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2658
!
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2659
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2660
inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2661
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2662
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2663
    "launch an inspector on the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2664
     this method (or better: inspectorClass) can be redefined in subclasses 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2665
     to start special inspectors."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2666
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2667
    |cls|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2668
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2669
    cls := self inspectorClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2670
    cls isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2671
        ^ self basicInspect
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2672
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2673
    cls openOn:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2674
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2675
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2676
     Object new inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2677
     (1 @ 2) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2678
     Smalltalk inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2679
     #(1 2 3) asOrderedCollection inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2680
     (Color red) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2681
     (Image fromFile:'bitmaps/garfield.gif') inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2682
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2683
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2684
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2685
inspectorClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2686
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2687
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2688
    "return the class to use for inspect. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2689
     Can (should) be redefined in classes for which a better inspector is available"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2690
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2691
    ^ Inspector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2692
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2693
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2694
mustBeBoolean
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2695
    "this message is sent by the VM, if a non-Boolean receiver is encountered
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2696
     in an if* or while* message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2697
     Caveat: for now, this is only sent by the interpreter;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2698
     both the JIT and the stc compiler treat it as undefined."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2699
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2700
    self error:'Non boolean receiver - proceed for truth' mayProceed:true.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2701
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2702
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2703
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2704
mustBeKindOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2705
    "for compatibility & debugging support: 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2706
     check if the receiver isKindOf:aClass and raise an error if not.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2707
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2708
        it is VERY questionable, if it makes sense to add manual
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2709
        type checks to a dynamically typed language like smalltalk. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2710
        It will, at least, slow down performance,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2711
        make your code less reusable and clutter your code with stupid sends
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2712
        of this selector. Also, read the comment in isKindOf:, regarding the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2713
        use of isXXX check methods.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2714
     You see: The author does not like this at all ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2715
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2716
    (self isKindOf:aClass) ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2717
        self error:'argument is not of expected type'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2718
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2719
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2720
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2721
obsoleteFeatureWarning
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2722
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2723
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2724
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2725
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2726
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2727
     Hopefully, this warning message is annoying enough for you to change the code... ;-)."
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2728
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2729
    self obsoleteFeatureWarning:nil from:thisContext sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2730
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2731
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2732
obsoleteFeatureWarning:message
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2733
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2734
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2735
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2736
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2737
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2738
     Hopefully, this warning message is annoying enough for you to change the code... ;-).
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2739
     This message is intended for application developers, so its printed as info message."
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2740
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2741
    self obsoleteFeatureWarning:message from:thisContext sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2742
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2743
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2744
obsoleteFeatureWarning:message from:aContext
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2745
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2746
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2747
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2748
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2749
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2750
     Hopefully, this warning message is annoying enough for you to change the code... ;-).
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2751
     This message is intended for application developers, so its printed as info message."
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2752
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2753
    |spec|
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2754
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2755
    spec := aContext methodPrintString.
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2756
    ('WARNING: the ''' , spec , ''' semantics will be changed.') infoPrintCR.
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2757
    ('         Its behavior may be different in future ST/X versions.') infoPrintCR.
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2758
    ('         called from ' , aContext sender printString) infoPrintCR.
7204
e968d9923408 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7202
diff changeset
  2759
    (aContext sender selector startsWith:'perform:') ifTrue:[
e968d9923408 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7202
diff changeset
  2760
    ('         called from ' , aContext sender sender printString) infoPrintCR.
e968d9923408 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7202
diff changeset
  2761
    ].
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2762
    message notNil ifTrue:[
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2763
        '------>  ' infoPrint. message infoPrintCR
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2764
    ]
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2765
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2766
    "
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2767
     Object obsoleteFeatureWarning:'foo' from:thisContext sender sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2768
    "
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2769
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  2770
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2771
obsoleteMethodWarning
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2772
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2773
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2774
    "in methods which are going to be obsoleted, a self send to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2775
     this method is used to tell programmers that a method is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2776
     used which is going to be removed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2777
     Find all methods which will be obsolete soon by looking at senders of this message.
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2778
     Hopefully, this warning message is annoying enough for you to change the code... ;-)"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2779
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2780
    self obsoleteMethodWarning:nil from:thisContext sender
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2781
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2782
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2783
obsoleteMethodWarning:message
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2784
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2785
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2786
    "in methods which are going to be obsoleted, a self send to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2787
     this method is used to tell programmers that a method is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2788
     used which is going to be removed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2789
     Find all methods which will be obsolete soon by looking at senders of this message.
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  2790
     Hopefully, this warning message is annoying enough for you to change the code... ;-)"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2791
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2792
    self obsoleteMethodWarning:message from:thisContext sender
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2793
!
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2794
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2795
obsoleteMethodWarning:message from:aContext
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2796
    "{ Pragma: +optSpace }"
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2797
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2798
    "in methods which are going to be obsoleted, a self-send to
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2799
     this method is used to tell programmers that a method is
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2800
     used which is going to be removed in later ST/X versions.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2801
     Find all methods which will be obsolete soon by looking at senders of this message.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2802
     Hopefully, this warning message is annoying enough for you to change the code... ;-).
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2803
     This message is intended for application developers, so its printed as info message."
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2804
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2805
    |spec sender|
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2806
9509
bfb55a08130d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9442
diff changeset
  2807
    Smalltalk isSmalltalkDevelopmentSystem ifFalse:[
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2808
        "ignore in production systems"
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2809
        ^ self.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2810
    ].
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2811
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2812
    spec := aContext methodPrintString.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2813
    sender := aContext sender.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2814
    ('WARNING: the ''' , spec , ''' method is obsolete.') infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2815
    ('         And may not be present in future ST/X versions.') infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2816
    ('         called from ' , sender printString) infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2817
    (sender selector startsWith:'perform:') ifTrue:[
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2818
        sender := sender sender.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2819
        (sender selector startsWith:'perform:') ifTrue:[
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2820
            sender := sender sender.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2821
        ].
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2822
        ('         called from ' , sender printString) infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2823
    ].
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2824
    message notNil ifTrue:[
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2825
        '------>  ' infoPrint. message infoPrintCR
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2826
    ]
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2827
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2828
    "
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2829
     Object obsoleteMethodWarning:'foo' from:thisContext sender sender
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  2830
    "
9509
bfb55a08130d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9442
diff changeset
  2831
bfb55a08130d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9442
diff changeset
  2832
    "Modified: / 10-08-2006 / 13:13:11 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2833
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2834
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2835
!Object methodsFor:'dependents access'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2836
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2837
addDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2838
    "make the argument, anObject be a dependent of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2839
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2840
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2841
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2842
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2843
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2844
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2845
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2846
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2847
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2848
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2849
        |deps dep|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2850
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2851
        deps := self dependents.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2852
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2853
        "/ to save a fair amount of memory in case of
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2854
        "/ many dependencies, we store a single dependent in
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2855
        "/ a WeakArray, and switch to a WeakSet if more dependents are
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2856
        "/ added.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2857
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2858
        (deps isNil or:[deps size == 0]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2859
            self dependents:(WeakArray with:anObject)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2860
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2861
            deps class == WeakArray ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2862
                dep := deps at:1.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2863
                dep ~~ anObject ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2864
                    (dep isNil or:[dep == 0]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2865
                        deps at:1 put:anObject
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2866
                    ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2867
                        self dependents:(WeakIdentitySet with:dep with:anObject)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2868
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2869
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2870
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2871
                deps add:anObject
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2872
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2873
        ]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  2874
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2875
        wasBlocked ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2876
            OperatingSystem unblockInterrupts
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2877
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2878
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2879
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2880
    "Modified: / 27.10.1997 / 19:35:52 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2881
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2882
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2883
breakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2884
    "remove all dependencies from the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2885
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2886
    self dependents:nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2887
    self nonWeakDependents:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2888
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2889
    "Modified: / 19.4.1996 / 10:55:36 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2890
    "Created: / 27.2.1998 / 11:26:11 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2891
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2892
8542
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2893
breakDependentsRecursively
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2894
    "remove all dependencies from the receiver and 
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2895
     recursively from all objects referred to by the receiver."
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2896
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2897
    self breakDependents.
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2898
    1 to:self class instSize do:[:idx | 
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2899
        (self instVarAt:idx) breakDependentsRecursively.
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2900
    ].
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2901
    1 to:self basicSize do:[:idx | 
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2902
        (self basicAt:idx) breakDependentsRecursively.
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2903
    ]
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2904
!
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  2905
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2906
dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2907
    "return a Collection of dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2908
     The default implementation here uses a global WeakDictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2909
     dependents 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2910
     This may be too slow for high frequency change&update,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2911
     therefore, some classes (Model) redefine this for better performance.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2912
     Notice the mentioning of a WeakDictionary - read the classes documentation."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2913
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2914
    |deps|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2915
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2916
    (deps := Dependencies at:self ifAbsent:nil) isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2917
        ^ #().
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2918
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2919
    ^ deps
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2920
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2921
    "Modified: / 26.1.1998 / 11:18:15 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2922
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2923
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2924
dependents:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2925
    "set the collection of dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2926
     The default implementation here uses a global Dictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2927
     dependents which may be too slow for high frequency change&update.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2928
     Therefore, some classes (Model) redefine this for better performance."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2929
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2930
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2931
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2932
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2933
    "/ faster execution (and to avoid creation of garbage blocks).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2934
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2935
    (OperatingSystem blockInterrupts) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2936
        "/ the common case - already blocked
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2937
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2938
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2939
            Dependencies removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2940
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2941
            Dependencies at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2942
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2943
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2944
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2945
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2946
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2947
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2948
            Dependencies removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2949
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2950
            Dependencies at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2951
        ].
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  2952
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2953
        OperatingSystem unblockInterrupts
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2954
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2955
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2956
    "Modified: 30.1.1997 / 21:22:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2957
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2958
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2959
dependentsDo:aBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2960
    "evaluate aBlock for all of my dependents"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2961
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2962
    |deps nwDeps|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2963
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2964
    deps := self dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2965
    deps size ~~ 0 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2966
        deps do:[:d | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2967
                    (d notNil and:[d ~~ 0]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2968
                        aBlock value:d
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2969
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2970
                ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2971
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2972
    nwDeps := self nonWeakDependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2973
    (nwDeps ~~ deps and:[nwDeps size ~~ 0]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2974
        nwDeps do:aBlock 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2975
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2976
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2977
    "Modified: / 30.1.1998 / 14:03:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2978
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2979
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2980
myDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2981
    "same as dependents - ST-80 compatibility"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2982
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2983
    ^ self dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2984
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2985
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2986
release
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2987
    "remove all references to objects that may refer to self.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2988
     Subclasses may redefine this method but should do a 'super release'."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2989
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2990
    self breakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2991
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2992
    "Modified: / 27.2.1998 / 11:29:35 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2993
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2994
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2995
removeDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2996
    "make the argument, anObject be independent of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2997
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2998
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2999
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3000
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3001
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3002
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3003
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3004
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3005
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3006
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3007
        |deps n d|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3008
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3009
        deps := self dependents.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3010
        deps size ~~ 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3011
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3012
            "/ to save a fair amount of memory in case of
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3013
            "/ many dependencies, we store a single dependent in
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3014
            "/ a WeakArray, and switch to a WeakSet if more dependents are
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3015
            "/ added. Here we have to do the inverse ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3016
9240
271ab8ebb7de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9221
diff changeset
  3017
            ((deps class == WeakArray) or:[deps class == Array]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3018
                ((d := deps at:1) == anObject 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3019
                or:[d isNil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3020
                or:[d == 0]]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3021
                    self dependents:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3022
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3023
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3024
                deps remove:anObject ifAbsent:[].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3025
                (n := deps size) == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3026
                    self dependents:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3027
                ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3028
                    n == 1 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3029
                        d := deps firstIfEmpty:nil.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3030
                        d notNil ifTrue:[
9246
601ed6b6b95d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9240
diff changeset
  3031
                            deps := (deps isWeakCollection ifTrue:WeakArray ifFalse:Array) with:d
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3032
                        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3033
                            deps := nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3034
                        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3035
                        self dependents:deps.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3036
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3037
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3038
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3039
        ]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3040
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3041
        wasBlocked ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3042
            OperatingSystem unblockInterrupts
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3043
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3044
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3045
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3046
    "Modified: / 26.1.1998 / 19:51:50 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3047
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3048
7266
f2b64d3b43cf method category rename
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3049
!Object methodsFor:'dependents access (non weak)'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3050
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3051
addNonWeakDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3052
    "make the argument, anObject be a nonWeak dependent of the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3053
     Be careful: this nonWeakDependency will prevent the dependent from being 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3054
     garbage collected unless the dependency is removed.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3055
     This is a private mechanism, for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3056
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3057
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3058
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3059
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3060
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3061
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3062
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3063
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3064
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3065
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3066
        |deps dep|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3067
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3068
        deps := self nonWeakDependents.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3069
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3070
        "/ to save a fair amount of memory in case of
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3071
        "/ many dependencies, we store a single dependent in
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3072
        "/ an Array, and switch to a Set if more dependents are
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3073
        "/ added.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3074
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3075
        deps size == 0 ifTrue:[
9442
f564054eaf6a do not add nil as dependent
Stefan Vogel <sv@exept.de>
parents: 9405
diff changeset
  3076
            anObject notNil ifTrue:[
f564054eaf6a do not add nil as dependent
Stefan Vogel <sv@exept.de>
parents: 9405
diff changeset
  3077
                self nonWeakDependents:(Array with:anObject).
f564054eaf6a do not add nil as dependent
Stefan Vogel <sv@exept.de>
parents: 9405
diff changeset
  3078
            ] ifFalse:[
f564054eaf6a do not add nil as dependent
Stefan Vogel <sv@exept.de>
parents: 9405
diff changeset
  3079
                "adding nil causes problems when adding the next one 
f564054eaf6a do not add nil as dependent
Stefan Vogel <sv@exept.de>
parents: 9405
diff changeset
  3080
                 (see below: trying to add nil to IdentitySet)"
f564054eaf6a do not add nil as dependent
Stefan Vogel <sv@exept.de>
parents: 9405
diff changeset
  3081
"/                self halt:'try to add nil to list of dependents'.
f564054eaf6a do not add nil as dependent
Stefan Vogel <sv@exept.de>
parents: 9405
diff changeset
  3082
            ].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3083
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3084
            deps class == Array ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3085
                dep := deps at:1.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3086
                dep ~~ anObject ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3087
                    self nonWeakDependents:(IdentitySet with:dep with:anObject)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3088
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3089
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3090
                deps add:anObject
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3091
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3092
        ]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3093
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3094
        wasBlocked ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3095
            OperatingSystem unblockInterrupts
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3096
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3097
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3098
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3099
    "Created: / 19.4.1996 / 10:54:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3100
    "Modified: / 30.1.1998 / 14:03:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3101
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3102
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3103
nonWeakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3104
    "return a Collection of nonWeakDependents - empty if there is none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3105
     This is a private mechanism for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3106
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3107
    NonWeakDependencies isNil ifTrue:[^ #()].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3108
    ^ NonWeakDependencies at:self ifAbsent:#()
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3109
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3110
    "Created: / 19.4.1996 / 10:55:06 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3111
    "Modified: / 30.1.1998 / 14:06:47 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3112
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3113
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3114
nonWeakDependents:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3115
    "set the collection of nonWeak dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3116
     This is a private helper for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3117
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3118
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3119
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3120
            NonWeakDependencies removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3121
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3122
            NonWeakDependencies at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3123
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3124
    ] valueUninterruptably
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3125
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3126
    "Created: 19.4.1996 / 11:07:47 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3127
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3128
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3129
removeNonWeakDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3130
    "remove a nonWeak dependency from the receiver to the argument, anObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3131
     (i.e. make it independent of the receiver)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3132
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3133
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3134
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3135
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3136
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3137
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3138
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3139
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3140
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3141
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3142
        |deps n|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3143
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3144
        deps := self nonWeakDependents.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3145
        deps size ~~ 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3146
            deps class == Array ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3147
                (deps at:1) == anObject ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3148
                    self nonWeakDependents:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3149
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3150
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3151
                deps remove:anObject ifAbsent:[].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3152
                (n := deps size) == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3153
                    self nonWeakDependents:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3154
                ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3155
                    n == 1 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3156
                        self nonWeakDependents:(Array with:(deps first))
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3157
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3158
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3159
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3160
        ]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3161
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3162
        wasBlocked ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3163
            OperatingSystem unblockInterrupts
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3164
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3165
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3166
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3167
    "Created: / 19.4.1996 / 11:44:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3168
    "Modified: / 30.1.1998 / 14:04:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3169
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3170
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3171
!Object methodsFor:'dependents-interests'!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3172
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3173
addInterest:anInterest
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3174
    "install an interest forwarder.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3175
     Here, we use the nonWeakDependencies."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3176
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3177
    self addNonWeakDependent:anInterest
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3178
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3179
    "Created: 14.10.1996 / 22:27:34 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3180
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3181
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3182
expressInterestIn:aspect for:anObject sendBack:aSelector
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3183
    "arrange for aSelector to be sent to anObject whenever the receiver
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3184
     changes aspect."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3185
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3186
    "/ for now, use an interestConverter, which is somewhat less efficient.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3187
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3188
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3189
    self addInterest:(InterestConverter 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3190
                            destination:anObject 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3191
                            selector:aSelector 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3192
                            aspect:aspect)
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3193
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3194
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3195
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3196
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3197
     b := [Transcript showCR:' -> the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3198
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3199
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3200
     Transcript showCR:'interest in #foo:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3201
     p expressInterestIn:#foo for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3202
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3203
     Transcript showCR:'now changing #bar ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3204
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3205
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3206
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3207
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3208
     Transcript showCR:'now changing #foo ... (expect notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3209
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3210
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3211
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3212
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3213
     Transcript showCR:'no more interest in #foo:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3214
     p retractInterestIn:#foo for:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3215
     Transcript showCR:'now changing #foo ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3216
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3217
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3218
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3219
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3220
     Transcript showCR:'interest in #bar now:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3221
     p expressInterestIn:#bar for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3222
     Transcript showCR:'now changing #foo ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3223
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3224
     Transcript showCR:'now changing #bar ... (expect notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3225
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3226
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3227
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3228
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3229
     Transcript showCR:'interest in #foo now:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3230
     p expressInterestIn:#foo for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3231
     Transcript showCR:'now changing #foo ... (expect notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3232
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3233
     Transcript showCR:'now changing #bar ... (expect notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3234
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3235
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3236
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3237
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3238
     Transcript showCR:'no more interests:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3239
     p retractInterestsFor:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3240
     Transcript showCR:'now changing #foo ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3241
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3242
     Transcript showCR:'now changing #bar...  (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3243
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3244
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3245
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3246
     p release.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3247
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3248
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3249
    "Created: 19.4.1996 / 10:26:22 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3250
    "Modified: 19.4.1996 / 12:34:08 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3251
    "Modified: 14.10.1996 / 22:28:20 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3252
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3253
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3254
interests
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3255
    "return a Collection of interests - empty if there is none.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3256
     Here, we use the nonWeakDependents for interests."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3257
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3258
    ^ self nonWeakDependents
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3259
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3260
    "Created: / 14.10.1996 / 22:20:51 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3261
    "Modified: / 30.1.1998 / 14:07:35 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3262
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3263
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3264
interestsFor:someOne
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3265
    "return a collection of interests of someOne - empty if there is none."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3266
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3267
    |coll deps|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3268
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3269
    deps := self interests.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3270
    deps size == 0 ifTrue:[^ #()].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3271
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3272
    coll := IdentitySet new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3273
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3274
    deps do:[:dep |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3275
        (dep isInterestConverter) ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3276
            dep destination == someOne ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3277
                coll add:dep.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3278
            ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3279
        ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3280
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3281
    ^ coll
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3282
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3283
    "Created: / 30.1.1998 / 14:02:26 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3284
    "Modified: / 30.1.1998 / 14:08:24 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3285
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3286
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3287
onChangeEvaluate:aBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3288
    "arrange for aBlock to be evaluated whenever the receiver changes."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3289
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3290
    ^ self onChangeSend:#value to:aBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3291
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3292
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3293
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3294
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3295
     b := [Transcript showCR:' -> the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3296
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3297
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3298
     Transcript showCR:'interest in #foo:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3299
     p onChangeEvaluate:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3300
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3301
     Transcript showCR:'now changing #bar ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3302
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3303
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3304
     p retractInterests.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3305
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3306
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3307
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3308
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3309
onChangeSend:aSelector to:anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3310
    "arrange for aSelector to be sent to anObject whenever the receiver
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3311
     changes."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3312
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3313
    "/ for now, use an interestConverter, which is somewhat less efficient.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3314
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3315
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3316
    ((self interests ? #())
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3317
        contains:[:anInterest |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3318
            (anInterest isInterestConverter)
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3319
            and:[ anInterest destination == anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3320
            and:[ anInterest selector == aSelector]]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3321
        ])
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3322
            ifTrue:[^ self].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3323
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3324
    self addInterest:(InterestConverter 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3325
                          destination:anObject 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3326
                          selector:aSelector)
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3327
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3328
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3329
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3330
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3331
     b := [Transcript showCR:'the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3332
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3333
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3334
     p onChangeSend:#value to:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3335
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3336
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3337
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3338
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3339
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3340
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3341
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3342
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3343
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3344
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3345
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3346
     Transcript showCR:'no more interest'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3347
     p retractInterestsFor:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3348
     Transcript showCR:'now changing again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3349
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3350
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3351
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3352
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3353
     Transcript showCR:'interest again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3354
     p onChangeSend:#value to:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3355
     Transcript showCR:'now changing again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3356
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3357
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3358
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3359
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3360
    "Created: 19.4.1996 / 10:26:38 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3361
    "Modified: 19.4.1996 / 12:34:26 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3362
    "Modified: 14.10.1996 / 22:28:27 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3363
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3364
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3365
removeInterest:anInterest
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3366
    "remove an interest forwarder.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3367
     Here, we use the nonWeakDependencies."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3368
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3369
    self removeNonWeakDependent:anInterest
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3370
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3371
    "Created: 14.10.1996 / 22:21:59 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3372
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3373
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3374
retractInterestIn:aspect for:someOne
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3375
    "remove the interest of someOne in the receiver changing aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3376
     (as installed with #expressInterestIn:for:sendBack:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3377
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3378
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3379
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3380
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3381
    self retractInterestsForWhich:[:i | (i aspect == aspect) and:[i destination == someOne]]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3382
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3383
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3384
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3385
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3386
     b := [Transcript showCR:'the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3387
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3388
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3389
     Transcript showCR:'interest in #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3390
     p expressInterestIn:#foo for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3391
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3392
     Transcript showCR:'now changing #bar'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3393
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3394
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3395
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3396
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3397
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3398
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3399
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3400
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3401
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3402
     Transcript showCR:'no more interest in #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3403
     p retractInterestIn:#foo for:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3404
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3405
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3406
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3407
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3408
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3409
     Transcript showCR:'interest in #bar now'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3410
     p expressInterestIn:#bar for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3411
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3412
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3413
     Transcript showCR:'now changing #bar'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3414
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3415
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3416
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3417
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3418
     Transcript showCR:'interest in #foo now'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3419
     p expressInterestIn:#foo for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3420
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3421
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3422
     Transcript showCR:'now changing #bar'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3423
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3424
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3425
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3426
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3427
     Transcript showCR:'no more interests'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3428
     p retractInterestsFor:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3429
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3430
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3431
     Transcript showCR:'now changing #bar'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3432
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3433
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3434
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3435
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3436
    "Created: / 19.4.1996 / 10:27:11 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3437
    "Modified: / 14.10.1996 / 22:21:19 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3438
    "Modified: / 30.1.1998 / 14:05:34 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3439
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3440
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3441
retractInterests
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3442
    "remove all interests in the receiver changing aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3443
     (as installed with #expressInterestIn:for:sendBack:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3444
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3445
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3446
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3447
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3448
    self retractInterestsForWhich:[:i | true ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3449
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3450
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3451
retractInterestsFor:someOne
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3452
    "remove the interest of someOne in the receiver 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3453
     (as installed with #onChangeSend:to:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3454
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3455
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3456
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3457
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3458
    self retractInterestsForWhich:[:i | i destination == someOne ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3459
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3460
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3461
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3462
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3463
     b := [Transcript showCR:'the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3464
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3465
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3466
     p onChangeSend:#value to:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3467
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3468
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3469
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3470
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3471
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3472
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3473
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3474
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3475
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3476
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3477
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3478
     Transcript showCR:'no more interest'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3479
     p retractInterestsFor:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3480
     Transcript showCR:'now changing again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3481
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3482
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3483
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3484
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3485
     Transcript showCR:'interest again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3486
     p onChangeSend:#value to:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3487
     Transcript showCR:'now changing again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3488
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3489
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3490
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3491
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3492
    "Created: / 19.4.1996 / 10:23:46 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3493
    "Modified: / 14.10.1996 / 22:21:25 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3494
    "Modified: / 30.1.1998 / 14:04:52 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3495
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3496
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3497
retractInterestsForWhich:aBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3498
    "remove all interests in the receiver changing aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3499
     (as installed with #expressInterestIn:for:sendBack:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3500
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3501
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3502
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3503
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3504
    |deps coll|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3505
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3506
    deps := self interests.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3507
    deps size ~~ 0 ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3508
        "/ cannot removeDependent within the loop - the interests collection rehashes
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3509
        coll := OrderedCollection new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3510
        deps do:[:dep |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3511
            dep isInterestConverter ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3512
                (aBlock value:dep) ifTrue:[coll add:dep].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3513
            ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3514
        ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3515
        coll do:[:dep |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3516
            self removeInterest:dep.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3517
        ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3518
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3519
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3520
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3521
retractInterestsIn:aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3522
    "remove all interests in the receiver changing aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3523
     (as installed with #expressInterestIn:for:sendBack:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3524
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3525
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3526
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3527
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3528
    self retractInterestsForWhich:[:i | i aspect == aspect ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3529
! !
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3530
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3531
!Object methodsFor:'dependents-st/v event simulation'!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3532
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3533
removeActionsForEvent:eventName
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3534
    "remove ST/V-style event triggers."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3535
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3536
    self retractInterestsIn:eventName
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3537
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3538
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3539
removeAllActionsWithReceiver:anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3540
    "remove ST/V-style event triggers."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3541
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3542
    self retractInterestsFor:anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3543
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3544
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3545
triggerEvent:eventSymbol withArguments:parameters
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3546
    "perform ST/V-style event triggering."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3547
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3548
    self changed:eventSymbol with:parameters.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3549
! !
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3550
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3551
!Object methodsFor:'displaying'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3552
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3553
ascentOn:aGC
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3554
    "when displayed via displayOn:, some objects assume that the given y coordinate
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3555
     is the baseline (strings, text etc. do), while others assume that the topY
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3556
     coordinate is given by y.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3557
     In other words: some draw above the given y coordinate.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3558
     This method returns the number of pixels by which the receiver will draw above
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3559
     the given y coordinate."
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3560
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3561
    ^ (aGC font onDevice:aGC device) ascent
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3562
!
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3563
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3564
displayOn:aGCOrStream
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3565
    "Compatibility
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3566
     append a printed desription on some stream (Dolphin,  Squeak)
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3567
     OR:
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3568
     display the receiver in a graphicsContext at 0@0 (ST80).
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3569
     This method allows for any object to be displayed in some view
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3570
     (although the fallBack is to display its printString ...)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3571
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3572
    "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3573
    "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3574
    (aGCOrStream isStream or:[aGCOrStream == Transcript]) ifTrue:[
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3575
        self printOn:aGCOrStream.
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3576
        ^ self
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3577
    ].
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3578
    ^ self displayOn:aGCOrStream x:0 y:0.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3579
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3580
    "Created: 29.5.1996 / 16:28:58 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3581
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3582
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3583
displayOn:aGC at:aPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3584
    "ST-80 Compatibility
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3585
     display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3586
     for any object to be displayed in a ListView - for example."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3587
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3588
    ^ self displayOn:aGC x:(aPoint x) y:(aPoint y).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3589
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3590
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3591
displayOn:aGC x:x y:y
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3592
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3593
     for any object to be displayed in a ListView - for example."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3594
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3595
    self displayOn:aGC x:x y:y opaque:false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3596
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3597
    "Modified: 29.5.1996 / 16:29:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3598
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3599
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3600
displayOn:aGc x:x y:y opaque:opaque
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3601
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3602
     for any object to be displayed in a ListView - for example.
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3603
     The fallBack here shows the receivers displayString.
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3604
     Notice, that the string is displayed on the baseLine;
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3605
     ask using #ascentOn: if required"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3606
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3607
    |s yBaseline|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3608
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3609
    s := self displayString.
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3610
    yBaseline := y "+ aGc font ascent".
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3611
    opaque ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3612
        aGc displayOpaqueString:s x:x y:yBaseline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3613
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3614
        aGc displayString:s x:x y:yBaseline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3615
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3616
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3617
    "Modified: 29.5.1996 / 16:29:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3618
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3619
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3620
displayOpaqueOn:aGC x:x y:y
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3621
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3622
     for any object to be displayed in a ListView - for example."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3623
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3624
    self displayOn:aGC x:x y:y opaque:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3625
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3626
    "Modified: / 29.5.1996 / 16:29:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3627
    "Created: / 26.10.1997 / 15:01:36 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3628
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3629
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3630
displayString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3631
    "return a string used when displaying the receiver in a view;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3632
     for example an Inspector. This is usually the same as printString,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3633
     but sometimes redefined for a better look."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3634
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3635
    |s|
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3636
8322
95ca965f65ed Handle unicode in #displayString
Stefan Vogel <sv@exept.de>
parents: 8300
diff changeset
  3637
    s := CharacterWriteStream on:(String new:32).
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3638
    self displayOn:s.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3639
    ^ s contents
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3640
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3641
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3642
     #(1 2 3) printString    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3643
     #(1 2 3) displayString  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3644
     #(1 2 3) storeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3645
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3646
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3647
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3648
heightOn:aGC
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3649
    "return the height of the receiver, if it is to be displayed on aGC"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3650
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3651
    ^ (aGC font onDevice:aGC device) heightOf:(self displayString)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3652
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3653
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3654
widthFrom:startIndex to:endIndex on:aGC
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3655
    "return the width of the receiver, if it is to be displayed on aGC"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3656
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3657
    ^ (aGC font onDevice:aGC device) widthOf:(self displayString) from:startIndex to:endIndex
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3658
!
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3659
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3660
widthOn:aGC
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3661
    "return the width of the receiver, if it is to be displayed on aGC"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3662
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3663
    ^ (aGC font onDevice:aGC device) widthOf:(self displayString)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3664
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3665
7359
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3666
!Object methodsFor:'double dispatching'!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3667
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3668
equalFromComplex:aComplex
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3669
    "adding this method here allows for any non-number to be compared to a complex
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3670
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3671
     Reason: we want to be able to put both numbers and non-numbers into a collection
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3672
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3673
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3674
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3675
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3676
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3677
equalFromFixedPoint:aFixedPoint
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3678
    "adding this method here allows for any non-number to be compared to a fixedPoint
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3679
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3680
     Reason: we want to be able to put both numbers and non-numbers into a collection
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3681
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3682
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3683
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3684
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3685
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3686
equalFromFloat:aFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3687
    "adding this method here allows for any non-number to be compared to a float
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3688
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3689
     Reason: we want to be able to put both numbers and non-numbers into a collection
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3690
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3691
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3692
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3693
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3694
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3695
equalFromFraction:aFraction
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3696
    "adding this method here allows for any non-number to be compared to a fraction
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3697
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3698
     Reason: we want to be able to put both numbers and non-numbers into a collection
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3699
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3700
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3701
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3702
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3703
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3704
equalFromInteger:anInteger
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3705
    "adding this method here allows for any non-number to be compared to an integer
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3706
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3707
     Reason: we want to be able to put both numbers and non-numbers into a collection
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3708
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3709
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3710
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3711
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3712
7455
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3713
equalFromLargeFloat:aLargeFloat
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3714
    "adding this method here allows for any non-number to be compared to a largeFloat
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3715
     and return false from this comparison.
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3716
     Reason: we want to be able to put both numbers and non-numbers into a collection
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3717
     which uses #= (i.e. a Set or Dictionary)."
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3718
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3719
    ^ false
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3720
!
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3721
7359
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3722
equalFromLongFloat:aLongFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3723
    "adding this method here allows for any non-number to be compared to a longFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3724
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3725
     Reason: we want to be able to put both numbers and non-numbers into a collection
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3726
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3727
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3728
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3729
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3730
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3731
equalFromShortFloat:aShortFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3732
    "adding this method here allows for any non-number to be compared to a shortFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3733
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3734
     Reason: we want to be able to put both numbers and non-numbers into a collection
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3735
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3736
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3737
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3738
! !
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3739
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3740
!Object methodsFor:'encoding & decoding'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3741
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3742
decodeAsLiteralArray
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3743
    "given a literalEncoding in the receiver,
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3744
     create & return the corresponding object.
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3745
     The inverse operation to #literalArrayEncoding."
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3746
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3747
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3748
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3749
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3750
encodeOn:anEncoder with:aParameter
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3751
    "not used any longer. Kept for backward comaptibility"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3752
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3753
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3754
8404
c0bd2a56dc3b *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 8397
diff changeset
  3755
    self acceptVisitor:anEncoder with:aParameter
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3756
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3757
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3758
encodingVectorForInstanceVariables
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3759
    "OBSOLETE, use elementDescriptorForInstanceVariables"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3760
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3761
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3762
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3763
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | true].
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3764
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3765
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3766
      #(1 2 3 nil true symbol) encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3767
      Dictionary new encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3768
      (5 @ nil) encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3769
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3770
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3771
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3772
encodingVectorForNonNilInstanceVariables
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3773
    "OBSOLETE, use elementDescriptorForNonNilInstanceVariables"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3774
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3775
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3776
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3777
    ^ self elementDescriptorForInstanceVariablesMatching:[:varVal | varVal notNil].
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3778
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3779
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3780
      #(1 2 3 nil true symbol) encodingVectorForNonNilInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3781
      (5 @ nil) encodingVectorForNonNilInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3782
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3783
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3784
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3785
fromLiteralArrayEncoding:aSpecArray
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3786
    "read my attributes from aSpecArray.
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3787
     Recursively decodes arguments."
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3788
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3789
    |sel litVal val
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3790
     stop   "{ Class:SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3791
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3792
    stop := aSpecArray size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3793
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3794
    2 to:stop by:2 do:[:i|
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3795
        sel := aSpecArray at:i.
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3796
        litVal := aSpecArray at:i + 1.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3797
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3798
        (self respondsTo:sel) ifTrue:[
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3799
            val := litVal decodeAsLiteralArray.
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3800
            self perform:sel with:val
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3801
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3802
            Transcript show:self class name; show:': unhandled literalArrayEncoding attribute: '.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3803
            Transcript showCR:sel.
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3804
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3805
            "/ thats a debug halt,
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3806
            "/ it should probably be removed (to simply ignore unhandled attributes)...
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3807
            "/ for now, it is left in, in order to easily find incompatibilities between
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3808
            "/ VW and ST/X.
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  3809
            self halt:('Unrecognized attribute in spec: #', sel).  "/ value is:   val  / litVal.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3810
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3811
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3812
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3813
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3814
literalArrayEncoding
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3815
    "generate a literalArrayEncoding array for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3816
     This uses #literalArrayEncodingSlotOrder which defines the slots and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3817
     order and #skippedInLiteralEncoding which defines slots to skip.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3818
     For most subclasses, there is no need to redefine those."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3819
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3820
    |names encoding cls skipped slots|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3821
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3822
    self isLiteral ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3823
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3824
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3825
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3826
    slots    := self literalArrayEncodingSlotOrder.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3827
    skipped  := self skippedInLiteralEncoding.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3828
    cls      := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3829
    names    := cls allInstVarNames.
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3830
    encoding := OrderedCollection new:(1 + (2 * (slots size - skipped size))).
8839
c4471cb2799f stefan: bitte vor Einchecken Testen !
Claus Gittinger <cg@exept.de>
parents: 8833
diff changeset
  3831
    encoding add:cls name.
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3833
    slots do:[:instSlot |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3834
        |value nm|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3835
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3836
        nm := names at:instSlot.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3837
        (skipped includes:nm) ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3838
            (value := self instVarAt:instSlot) notNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3839
                encoding add:(nm , ':') asSymbol.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3840
                encoding add:value literalArrayEncoding
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3841
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3842
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3843
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3844
    ^ encoding asArray
8841
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  3845
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  3846
    "
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  3847
        (1 -> 2) literalArrayEncoding
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  3848
        DebugView menuSpec decodeAsLiteralArray literalArrayEncoding  =
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  3849
           DebugView menuSpec
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  3850
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3851
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3852
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3853
literalArrayEncodingSlotOrder
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3854
    "define the order in which inst-slots are saved when generating
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3855
     a literalArrayEncoding"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3856
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3857
    ^ 1 to:self class instSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3858
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3859
7112
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  3860
postDecodeFrom:aDecoder aspect:aspectSymbol
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  3861
    "invoked by xmlDecoder (and others in the future), after an
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  3862
     object has been decoded (i.e. its instance variables have been restored)"
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  3863
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3864
    ^ self
7112
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  3865
!
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  3866
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3867
skippedInLiteralEncoding
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3868
    "return a Collection with it's elements are slots for skipping"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3869
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3870
    ^ #()
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3871
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3872
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3873
!Object methodsFor:'error handling'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3874
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3875
appropriateDebugger:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3876
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3877
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3878
    "return an appropriate debugger to use.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3879
     If there is already a debugger active on the stack, and it is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3880
     the DebugView, return MiniDebugger (as a last chance) otherwise abort."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3881
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3882
    |context|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3883
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3884
    "DebugView cannot run without system processes"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3885
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3886
    (Processor isNil 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3887
    or:[Processor activeProcessIsSystemProcess
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3888
    or:[Smalltalk isInitialized not]]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3889
        ^ MiniDebugger
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3890
    ].
6778
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  3891
    (Screen isNil or:[Screen default isNil or:[Screen default isOpen not]]) ifTrue:[
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  3892
        Debugger isNil ifTrue:[^ nil].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3893
        ^ MiniDebugger
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3894
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3895
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3896
    context := thisContext.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3897
    context := context findNextContextWithSelector:aSelector or:nil or:nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3898
    [context notNil] whileTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3899
        ((context receiver class == Debugger) 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3900
         and:[context selector == aSelector]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3901
            "we are already in some Debugger"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3902
            (Debugger == MiniDebugger) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3903
                "we are already in the MiniDebugger"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3904
                ErrorRecursion ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3905
                    Smalltalk fatalAbort:'recursive error ...'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3906
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3907
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3908
            MiniDebugger isNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3909
                Smalltalk fatalAbort:'no debugger'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3910
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3911
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3912
            "ok, an error occured while in the graphical debugger;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3913
             lets try MiniDebugger"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3914
            ^ MiniDebugger
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3915
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3916
        context := context findNextContextWithSelector:aSelector or:nil or:nil.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3917
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3918
    "not within Debugger - no problem"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3919
    ^ Debugger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3920
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3921
    "Modified: / 23.9.1996 / 12:14:52 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3922
    "Modified: / 19.5.1999 / 18:05:00 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3923
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3924
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3925
cannotSendMessage:aMessage to:someReceiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3926
    "this message is sent by the runtime system (VM),
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3927
     when a message is sent to some object, whose class is not
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3928
     a valid behavior (see documentation in Behavior)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3929
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3930
    ^ VMInternalError
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3931
          raiseWith:someReceiver
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3932
          errorString:('bad class in send of #' , aMessage selector)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3933
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3934
    "Modified: 23.1.1997 / 00:05:39 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3935
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3936
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3937
doesNotUnderstand:aMessage
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3938
    "this message is sent by the runtime system (VM) when
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3939
     a message is not understood by some object (i.e. there
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3940
     is no method for that selector). The original message has
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3941
     been packed into aMessage (i.e. the receiver, selector and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3942
     any arguments) and the original receiver is then sent the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3943
     #doesNotUnderstand: message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3944
     Here, we raise another signal which usually enters the debugger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3945
     You can of course redefine #doesNotUnderstand: in your classes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3946
     to implement message delegation, 
8500
10d47cede03c Speed up MessageNotUnderstood exception sending by layz computation
Stefan Vogel <sv@exept.de>
parents: 8481
diff changeset
  3947
     or handle the MessageNotUnderstood exception gracefully."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3948
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3949
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3950
8500
10d47cede03c Speed up MessageNotUnderstood exception sending by layz computation
Stefan Vogel <sv@exept.de>
parents: 8481
diff changeset
  3951
    ^ MessageNotUnderstood raiseRequestWith:aMessage
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3952
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3953
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3954
elementBoundsError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3955
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3956
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3957
    "report an error that badElement is out of bounds 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3958
     (i.e. cannot be put into that collection).
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3959
     The error is reported by raising the ElementBoundsError exception."
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3960
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3961
    ^ ElementBoundsError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3962
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3963
    "Modified: 8.5.1996 / 09:12:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3964
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3965
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3966
elementBoundsError:aValue
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3967
    "{ Pragma: +optSpace }"
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3968
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3969
    "report an error that aValue is not valid as element  
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3970
     (i.e. cannot be put into that collection).
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3971
     The error is reported by raising the ElementBoundsError exception."
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3972
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3973
    ^ ElementBoundsError raiseWith:aValue
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3974
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3975
    "Modified: 8.5.1996 / 09:12:45 / cg"
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3976
!
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3977
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3978
elementNotCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3979
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3980
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3981
    "report an error that object to be stored is no Character.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3982
     (usually when storing into Strings).
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3983
     The error is reported by raising the ElementBoundsError exception."
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3984
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3985
    ^ ElementBoundsError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3986
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3987
    "Modified: 8.5.1996 / 09:12:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3988
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3989
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3990
elementNotInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3991
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3992
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3993
    "report an error that object to be stored is not Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3994
     (in collections that store integers only).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3995
     The error is reported by raising the ElementOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3996
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  3997
    ^ ElementBoundsError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3998
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3999
    "Modified: 8.5.1996 / 09:12:51 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4000
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4001
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4002
error
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4003
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4004
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4005
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4006
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4007
    "report error that an error occured.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4008
     The error is reported by raising the Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4009
     which is non-proceedable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4010
     If no handler has been setup, a debugger is entered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4011
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4012
    Error raiseWith:#error:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4013
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4014
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4015
     nil error
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4016
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4017
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4018
    "Modified: / 8.5.1996 / 09:13:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4019
    "Modified: / 2.8.1999 / 17:00:19 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4020
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4021
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4022
error:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4023
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4024
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4025
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4026
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4027
    "Raise an error with error message aString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4028
     The error is reported by raising the Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4029
     which is non-proceedable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4030
     If no handler has been setup, a debugger is entered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4031
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4032
    Error raiseWith:#error: errorString:aString 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4033
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4034
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4035
      nil error:' bad bad bad'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4036
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4037
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4038
    "Modified: 8.5.1996 / 09:13:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4039
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4040
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4041
error:aString mayProceed:mayProceed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4042
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4043
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4044
    "enter debugger with error-message aString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4045
     The error is reported by raising either the 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4046
     non-proceedable Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4047
     or the ProceedableError exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4048
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4049
    mayProceed ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4050
        ^ ProceedableError raiseRequestWith:#error: errorString:aString 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4051
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4052
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4053
    Error raiseWith:#error: errorString:aString 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4054
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4055
    "Modified: 8.5.1996 / 09:13:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4056
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4057
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4058
errorInvalidFormat
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4059
    "{ Pragma: +optSpace }"
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4060
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4061
    <context: #return>
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4062
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4063
    "report an error that some conversion to/from string representation failed
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4064
     typically when converting numbers, date, time etc."
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4065
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4066
    ^ ConversionError raiseErrorString:'invalid format'
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4067
!
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4068
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4069
errorKeyNotFound:aKey
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4070
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4071
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4072
    "report an error that a key was not found in a collection.
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4073
     The error is reported by raising the KeyNotFoundError exception."
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4074
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4075
    ^ KeyNotFoundError raiseRequestWith:aKey
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4076
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4077
    "
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4078
     Dictionary new at:#nonExistantElement
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4079
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4080
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4081
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4082
errorNotFound
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4083
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4084
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4085
    "report an error that no element was found in a collection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4086
     The error is reported by raising the NotFoundSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4087
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4088
    ^ NotFoundError raiseRequestWith:nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4089
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4090
    "Modified: / 8.5.1996 / 09:13:11 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4091
    "Modified: / 26.7.1999 / 10:51:50 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4092
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4093
6874
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4094
errorNotFound:errorString
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4095
    "{ Pragma: +optSpace }"
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4096
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4097
    "report an error that no element was found in a collection.
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4098
     The error is reported by raising the NotFoundSignal exception."
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4099
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4100
    ^ NotFoundError raiseErrorString:errorString
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4101
!
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4102
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4103
errorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4104
    ^ self class errorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4105
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4106
    "Created: / 19.6.1998 / 02:32:32 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4107
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4108
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4109
halt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4110
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4111
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4112
    "enter debugger with halt-message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4113
     The error is reported by raising the HaltSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4114
6716
7e2bac4221d1 allow for halts to be ignored
Claus Gittinger <cg@exept.de>
parents: 6708
diff changeset
  4115
    (Smalltalk at:#IgnoreHalt ifAbsent:false) == true ifTrue:[^ self].
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4116
    ^ HaltInterrupt raiseRequestWith:#halt
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4117
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4118
    "Modified: / 2.8.1999 / 17:00:29 / stefan"
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4119
    "Modified: / 17.11.2001 / 22:47:44 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4120
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4121
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4122
halt:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4123
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4124
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4125
    "enter debugger with halt-message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4126
     The error is reported by raising the HaltSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4127
6716
7e2bac4221d1 allow for halts to be ignored
Claus Gittinger <cg@exept.de>
parents: 6708
diff changeset
  4128
    (Smalltalk at:#IgnoreHalt ifAbsent:false) == true ifTrue:[^ self].
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4129
    ^ HaltInterrupt raiseRequestWith:#halt: errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4130
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4131
    "Modified: 8.5.1996 / 09:13:23 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4132
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4133
7322
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4134
handlerForSignal:exceptionHandler context:theContext originator:originator
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4135
    " should never be invoked for non-blocks/non-exceptions/non-signals"
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4136
7566
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4137
    thisContext isRecursive ifTrue:[^ nil].
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4138
7322
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4139
    'Warning: handlerForSignal invoked for: ' print. self printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4140
    '         context: ' print. theContext printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4141
    '         originator: ' print. originator printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4142
    '         sender: ' print. thisContext sender printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4143
7566
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4144
    "/ MiniDebugger enter:thisContext withMessage:'oops' mayProceed:true.
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4145
    self error:'this method should only be invoked for blocks, exceptions and signals'.
7322
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4146
!
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4147
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4148
implementedBySubclass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4149
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4150
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4151
    "this is sent by ST/V code - its the same as #subclassResponsibility"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4152
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4153
    ^ self subclassResponsibility:'method must be reimplemented in ST/V subclass'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4154
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4155
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4156
indexNotInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4157
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4158
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4159
    "report an error that index is not an Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4160
     (when accessing collections indexed by an integer key).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4161
     The error is reported by raising the NonIntegerIndexSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4162
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4163
    ^ NonIntegerIndexError raiseRequestWith:nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4164
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4165
    "Modified: / 8.5.1996 / 09:13:37 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4166
    "Modified: / 26.7.1999 / 10:57:43 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4167
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4168
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4169
indexNotInteger:anIndex
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4170
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4171
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4172
    "report an error that index is not an Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4173
     (when accessing collections indexed by an integer key).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4174
     The error is reported by raising the NonIntegerIndexSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4175
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4176
    ^ NonIntegerIndexError raiseRequestWith:anIndex 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4177
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4178
    "Created: / 16.5.1998 / 19:39:41 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4179
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4180
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4181
indexNotIntegerOrOutOfBounds:index
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4182
    "{ Pragma: +optSpace }"
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4183
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4184
    "report an error that index is either non-integral or out of bounds"
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4185
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4186
    index isInteger ifFalse:[
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4187
        ^ self indexNotInteger:index
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4188
    ].
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4189
    ^ self subscriptBoundsError:index
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4190
!
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4191
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4192
integerCheckError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4193
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4194
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4195
    "generated when a variable declared with an integer type gets a bad
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4196
     value assigned"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4197
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4198
    ^ self error:'bad assign of ' , self printString , 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4199
                  ' (' , self class name , ') to integer-typed variable'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4200
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4201
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4202
invalidCodeObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4203
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4204
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4205
    self error:'not an executable code object'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4206
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4207
    "Created: 1.8.1997 / 00:16:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4208
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4209
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4210
invalidMessage 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4211
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4212
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4213
    "this is sent by ST/V code - its the same as #shouldNotImplement"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4214
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4215
    ^ self shouldNotImplement
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4216
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4217
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4218
mustBeRectangle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4219
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4220
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4221
    "report an argument-not-rectangle-error"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4222
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4223
    ^ self error:'argument must be a Rectangle'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4224
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4225
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4226
mustBeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4227
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4228
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4229
    "report an argument-not-string-error"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4230
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4231
    ^ self error:'argument must be a String'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4232
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4233
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4234
notIndexed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4235
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4236
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4237
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4238
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4239
    "report an error that receiver has no indexed instance variables.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4240
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4241
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4242
    ^ SubscriptOutOfBoundsError 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4243
        raiseErrorString:'receiver has no indexed variables'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4244
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4245
    "Modified: 26.7.1996 / 16:43:13 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4246
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4247
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4248
openDebuggerOnException:ex
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4249
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4250
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4251
    "enter the debugger on some unhandled exception"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4252
6884
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4253
    |msgString debugger answer|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4254
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4255
    msgString := ex description.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4256
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4257
     if there is no debugger,
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4258
     ask for ignore or exit. Exit will terminate the application.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4259
     ignore will raise an AbortOperationRequest.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4260
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4261
    Debugger isNil ifTrue:[
6840
073cdeca1681 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
  4262
        msgString := 'Error: ' , msgString.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4263
7562
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4264
        thisContext isRecursive ifTrue:[
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4265
            msgString errorPrintCR.
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4266
            Smalltalk fatalAbort:'recursive unhandled exception'
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4267
        ].
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4268
9509
bfb55a08130d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9442
diff changeset
  4269
        Smalltalk isSmalltalkDevelopmentSystem ifFalse:[
9297
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4270
            ex parameter signal == HaltInterrupt ifTrue:[
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4271
                "/ 'Halt ignored' infoPrintCR.
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4272
                ^ self
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4273
            ].
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4274
7562
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4275
            (Dialog notNil and:[Screen default notNil]) ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4276
                AbortOperationRequest isHandled ifTrue:[
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4277
                    answer := OptionBox
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4278
                            request:msgString
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4279
                            label:msgString
9299
f5fe49cd9bcc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9298
diff changeset
  4280
                            buttonLabels:#('Exit' 'Terminate Thread' 'Ignore' 'Abort' )
f5fe49cd9bcc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9298
diff changeset
  4281
                            values:#(exit terminate ignore abort)
9298
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4282
                            default:#abort.
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4283
                ] ifFalse:[
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4284
                    answer := OptionBox
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4285
                            request:msgString
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4286
                            label:msgString
9299
f5fe49cd9bcc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9298
diff changeset
  4287
                            buttonLabels:#('Exit' 'Terminate Thread' 'Ignore' )
f5fe49cd9bcc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9298
diff changeset
  4288
                            values:#(exit terminate ignore )
9298
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4289
                            default:#terminate.
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4290
                ].
7562
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4291
6884
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4292
                answer == #abort ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4293
                    ^ AbortOperationRequest raiseRequest
6884
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4294
                ].
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4295
                answer == #ignore ifTrue:[
6884
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4296
                    ^ nil
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4297
                ].
9298
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4298
                answer == #terminate ifTrue:[
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4299
                    ^ Processor activeProcess terminate.
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4300
                ].
9314
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4301
                "asking second time here to prevent the user from accidently closing his app"
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4302
                answer == #exit ifTrue:[
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4303
                    answer := OptionBox
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4304
                            request:'Do you really wish to exit this application (all changes will be lost)?'
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4305
                            label:msgString
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4306
                            buttonLabels:#('Yes' 'No' )
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4307
                            values:#(exit abort)
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4308
                            default:#abort.
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4309
                ].
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4310
                answer == #abort ifTrue:[
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4311
                    ^ AbortOperationRequest raiseRequest
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4312
                ].
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4313
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4314
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4315
            ].
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4316
            "don't output the message, if its a CTRL-C (userInterrupt)" 
6845
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4317
            ex signal == NoHandlerError ifTrue:[
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4318
                ex parameter signal == UserInterrupt ifTrue:[
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4319
                    OperatingSystem exit:130
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4320
                ].
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4321
            ].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4322
            msgString errorPrintCR.
9203
9bd6647d1c63 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9146
diff changeset
  4323
            thisContext fullPrintAll.    
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4324
            OperatingSystem exit:1
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4325
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4326
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4327
        msgString errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4328
        Smalltalk fatalAbort:'no Debugger defined'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4329
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4330
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4331
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4332
     find an appropriate debugger to use
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4333
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4334
    debugger := self appropriateDebugger:(thisContext selector).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4335
    debugger isNil ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4336
        ^ AbortOperationRequest raiseRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4337
    ].    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4338
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4339
    ^ debugger 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4340
        enter:ex suspendedContext
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4341
        withMessage:msgString 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4342
        mayProceed:(ex mayProceed).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4343
9509
bfb55a08130d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9442
diff changeset
  4344
    "Modified: / 10-08-2006 / 13:13:22 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4345
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4346
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4347
primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4348
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4349
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4350
    "report an error that some primitive code failed.
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4351
     The error is reported by raising the PrimitiveFailure exception."
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4352
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4353
    |sender|
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4354
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4355
    sender := thisContext sender.
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4356
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4357
    ^ PrimitiveFailure raiseRequestWith:(Message selector:sender selector arguments:sender args)
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4358
                       in:sender.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4359
6005
012813d02bf7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6000
diff changeset
  4360
    "
012813d02bf7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6000
diff changeset
  4361
     1234 primitiveFailed
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4362
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4363
     [
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4364
        ExternalBytes new   basicAt:40
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4365
     ] on:PrimitiveFailure do:[:ex|
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4366
        ex inspect
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4367
     ]
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4368
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4369
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4370
8977
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4371
primitiveFailed:messageString
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4372
    "{ Pragma: +optSpace }"
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4373
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4374
    "report an error that some primitive code failed.
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4375
     The error is reported by raising the PrimitiveFailureSignal exception."
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4376
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4377
    |sender|
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4378
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4379
    sender := thisContext sender.
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4380
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4381
    ^ PrimitiveFailure raiseRequestWith:(Message selector:sender selector arguments:sender args)
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4382
                       errorString:messageString 
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4383
                       in:sender.
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4384
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4385
    "
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4386
     1234 primitiveFailed:'this is a test'
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4387
    "
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4388
!
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4389
6815
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4390
shouldImplement
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4391
    "{ Pragma: +optSpace }"
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4392
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4393
    "report an error that this message should be implemented.
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4394
     This is send by automatically generated method bodies"
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4395
9216
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4396
    |sender|
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4397
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4398
    sender := thisContext sender.
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4399
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4400
    ^ UnimplementedFunctionalityError raiseRequestWith:(Message selector:sender selector arguments:sender args)
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4401
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4402
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4403
     "
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4404
        self shouldImplement
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4405
     "
6815
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4406
!
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4407
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4408
shouldNotImplement
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4409
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4410
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4411
    "report an error that this message should not be implemented"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4412
8729
2e454c09b38a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8690
diff changeset
  4413
    ^ self error:'method/functionality not appropriate for this class'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4414
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4415
    "Modified: 8.5.1996 / 09:09:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4416
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4417
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4418
subclassResponsibility
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4419
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4420
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4421
    "report an error that this message should have been reimplemented in a
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4422
     subclass"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4423
7334
7da368a2f0da *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7322
diff changeset
  4424
    ^ SubclassResponsibilityError raiseRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4425
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4426
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4427
subclassResponsibility:msg
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4428
    "{ Pragma: +optSpace }"
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4429
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4430
    "report an error that this message should have been reimplemented in a subclass"
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4431
7334
7da368a2f0da *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7322
diff changeset
  4432
    ^ SubclassResponsibilityError raiseRequestErrorString:msg
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4433
!
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4434
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4435
subscriptBoundsError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4436
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4437
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4438
    "report an error that some index is out of bounds.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4439
     (when accessing indexable collections).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4440
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4441
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4442
    ^ SubscriptOutOfBoundsSignal raiseRequestWith:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4443
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4444
    "Modified: / 26.7.1996 / 16:45:42 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4445
    "Modified: / 26.7.1999 / 10:58:27 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4446
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4447
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4448
subscriptBoundsError:anIndex
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4449
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4450
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4451
    "report an error that anIndex is out of bounds.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4452
     (when accessing indexable collections).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4453
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4454
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4455
    ^ SubscriptOutOfBoundsError 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4456
        raiseRequestWith:anIndex 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4457
        errorString:('subscript (' , anIndex printString , ') out of bounds')
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4458
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4459
    "Modified: / 17.11.2001 / 22:49:56 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4460
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4461
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4462
typeCheckError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4463
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4464
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4465
    "generated when a variable declared with a type hint gets a bad
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4466
     value assigned"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4467
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4468
    ^ self error:'bad assign of ' , self printString ,
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4469
                  ' (' , self class name , ') to typed variable'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4470
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4471
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4472
!Object methodsFor:'evaluation'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4473
8690
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4474
argumentCount
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4475
    "compatibility with Blocks and Messages.
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4476
     Answer 0, since we only understand #value.
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4477
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4478
     By implementing this, you can pass any object as an exception handler."
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4479
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4480
    ^ 0
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4481
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4482
    "
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4483
        [1 // 0] on:ArithmeticError do:9999
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4484
    "
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4485
!
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4486
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4487
value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4488
    "return the receiver itself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4489
     This allows every object to be used where blocks or valueHolders
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4490
     are typically used, and allows for valueHolders and blocks to be
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4491
     used interchangably in some situations.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4492
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4493
     Time will show, if this is a good idea or leads to sloppy programming
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4494
     style ... (the idea was borrowed from the Self language).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4495
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4496
     WARNING: dont 'optimize' away ifXXX: blocks 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4497
              (i.e. do NOT replace 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4498
                        foo ifTrue:[var1] ifFalse:[var2]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4499
               by:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4500
                        foo ifTrue:var1 ifFalse:var2
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4501
              )
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4502
              - the compilers will only generate inline code for the if, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4503
                iff the argument(s) are blocks - otherwise, a true send is
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4504
                generated.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4505
              This 'oprimization' will work semantically correct,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4506
              but execute SLOWER instead."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4507
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4508
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4509
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4510
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4511
     #(1 2 3 4) indexOf:5 ifAbsent:0     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4512
     #(1 2 3 4) indexOf:5 ifAbsent:[0]     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4513
     1 > 2 ifTrue:['yes'] ifFalse:['no']  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4514
     1 > 2 ifTrue:'yes' ifFalse:'no'       
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4515
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4516
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4517
    "DO NOT DO THIS (its slower)
7458
b0ca7546cbd6 CG: comment in value
Stefan Vogel <sv@exept.de>
parents: 7455
diff changeset
  4518
     (1 > 4) ifTrue:a ifFalse:b
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4519
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4520
     USE (the compiler optimizes blocks in if/while):
7458
b0ca7546cbd6 CG: comment in value
Stefan Vogel <sv@exept.de>
parents: 7455
diff changeset
  4521
     (1 > 4) ifTrue:[a] ifFalse:[b]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4522
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4523
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4524
    "Modified: 3.5.1996 / 11:57:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4525
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4526
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4527
!Object methodsFor:'finalization'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4528
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4529
disposed
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4530
    "OBSOLETE INTERFACE: use #finalize
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4531
     this is invoked for objects which have been registered
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4532
     in a Registry, when the original object dies.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4533
     Subclasses may redefine this method"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4534
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4535
    <resource: #obsolete>
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4536
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4537
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4538
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4539
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4540
executor
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4541
    "Return the object which does the finalization for me.
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4542
     This interface is also VW & Sqeak compatible,"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4543
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4544
    "for now, send #shallowCopyForFinalization, to be compatible with
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4545
     classes designed for old ST/X versions"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4546
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4547
    ^ self shallowCopyForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4548
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4549
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4550
finalizationLobby
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4551
    "answer a Registry used for finalization.
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4552
     Use a generic Registry for any object.
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4553
     Subclasses using their own Registry should redefine this"
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4554
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4555
    ^ FinalizationLobby
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4556
!
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4557
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4558
finalize
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4559
    "this is invoked for executor objects which have been registered
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4560
     in a Registry, when the original object dies.
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4561
     Subclasses may redefine this method
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4562
     This interface is also VW-compatible"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4563
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4564
    "send #disposed for compatibility with existing classes that still
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4565
     implement the obsolete #disposed message"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4566
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4567
    ^ self disposed
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4568
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4569
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4570
reRegisterForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4571
    "re-register mySelf for later finalization.
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4572
     This will create a new executor, which will receive a #finalize message when
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4573
     the receiver is garbage collected."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4574
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4575
    self finalizationLobby registerChange:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4576
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4577
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4578
registerForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4579
    "register mySelf for later finalization.
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4580
     Once registered, the executor of the receiver will receive a #finalize message when
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4581
     the receiver is garbage collected."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4582
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4583
    self finalizationLobby register:self
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4584
!
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4585
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4586
shallowCopyForFinalization
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4587
    "OBSOLETE INTERFACE: use #executor.
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4588
     This is used to aquire a copy to be used for finalization -
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4589
     (the copy will be sent a #finalize message; see the documentation in the Registry class)
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4590
     This method can be redefined for more efficient copying - especially for large objects."
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4591
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4592
    <resource: #obsolete>
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4593
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4594
    ^ self shallowCopy
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4595
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4596
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4597
unregisterForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4598
    "unregister mySelf from later finalization"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4599
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4600
    self finalizationLobby unregister:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4601
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4602
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4603
!Object methodsFor:'initialization'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4604
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4605
initialize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4606
    "just to ignore initialize to objects which do not need it"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4607
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4608
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4609
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4610
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4611
!Object methodsFor:'interrupt handling'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4612
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4613
childSignalInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4614
    "death of a child process (unix process) - do nothing"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4615
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4616
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4617
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4618
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4619
customInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4620
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4621
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4622
    "a custom interrupt - but no handler has defined"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4623
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4624
    self error:'custom interrupt' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4625
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4626
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4627
errorInterrupt:errorID with:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4628
    "subsystem error. The arguments errorID and aParameter are the values passed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4629
     to the 'errorInterruptWithIDAndParameter(id, param)' function, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4630
     which can be called from C subsystems to raise an (asynchronous)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4631
     error exception.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4632
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4633
     Currently, this is used to map XErrors to smalltalk errors, but can be
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4634
     used from other C subsystems too, to upcast errors.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4635
     Especially, for subsystems which call errorHandler functions asynchronously.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4636
     IDs (currently) used:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4637
        #DisplayError ..... x-error interrupt
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4638
        #XtError      ..... xt-error interrupt (Xt interface is not yet published)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4639
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4640
6263
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  4641
    |handlers handler|
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  4642
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  4643
    handlers := ObjectMemory registeredErrorInterruptHandlers.
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  4644
    handlers notNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4645
        handler := handlers at:errorID ifAbsent:nil.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4646
        handler notNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4647
            "/
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4648
            "/ handler found; let it do whatever it wants ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4649
            "/
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4650
            handler errorInterrupt:errorID with:aParameter.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4651
            ^ self
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4652
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4653
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4654
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4655
    "/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4656
    "/ no handler - raise errorSignal passing the errorId as parameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4657
    "/
7094
617eeaf2f8ba Convert Object>>errorSignal -> Error
Stefan Vogel <sv@exept.de>
parents: 7081
diff changeset
  4658
    ^ Error 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4659
        raiseRequestWith:errorID 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4660
        errorString:('Subsystem error. ErrorID = ' , errorID printString)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4661
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4662
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4663
exceptionInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4664
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4665
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4666
    "exception interrupt - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4667
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4668
    self error:'exception Interrupt' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4669
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4670
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4671
fpExceptionInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4672
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4673
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4674
    "a floating point exception occured - this one
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4675
     has to be handled differently since it comes asynchronous
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4676
     on some machines (for example, on machines with a separate FPU
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4677
     or superscalar architectures. Also, errors from within primitive code
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4678
     (or library functions such as GL) are sent via the Unix-signal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4679
     mechanism this way."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4680
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4681
    |where rec|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4682
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4683
    where := thisContext sender.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4684
    rec := where receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4685
    rec isNumber ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4686
        ^ rec class
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4687
            raise:#domainErrorSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4688
            receiver:rec
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4689
            selector:where selector
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4690
            arguments:(where args asArray)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4691
            errorString:'floating point exception'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4692
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4693
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4694
    "/ could be in some C-library ...
7402
b9d45ce2463a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7359
diff changeset
  4695
    ^ DomainError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4696
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4697
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4698
internalError:msg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4699
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4700
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4701
    "this is triggered, when VM hits some bad error,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4702
     such as corrupted class, corrupted method/selector array
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4703
     etc. The argument string gives some more information on what happened.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4704
     (for example, if you set an objects class to a non-behavior, nil etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4705
     Its not guaranteed, that the system is in a working condition once
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4706
     this error occurred ...."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4707
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4708
    VMInternalError raiseWith:self errorString:msg
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4709
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4710
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4711
ioInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4712
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4713
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4714
    "I/O (SIGIO/SIGPOLL) interrupt (supposed to be sent to Processor).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4715
     If we arrive here, there is either no handler (ObjMem>>ioInterruptHandler)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4716
     or it does not understand the ioInterrupt message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4717
     In any case, this is a sign of some big trouble. Enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4718
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4719
    self error:'I/O Interrupt - but no handler' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4720
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4721
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4722
memoryInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4723
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4724
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4725
    "out-of-memory interrupt and no handler - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4726
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4727
    self error:'almost out of memory' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4728
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4729
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4730
recursionInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4731
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4732
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4733
    "recursion limit (actually: stack overflow) interrupt.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4734
     This interrupt is triggered, when a process stack grows above
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4735
     its stackLimit - usually, this leads into the debugger, but
6175
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4736
     could be caught.
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4737
     Under Unix, the stackLimit may be increased in the handler,
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4738
     and the exception can be resumed.
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4739
     Sorry, but under win32, the stack cannot grow, and the exception
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4740
     is not proceedable.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4741
     At the time we arrive here, the system has still some stack 
6175
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4742
     as a reserve so we can continue to do some useful work, or cleanup,
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4743
     or debug for a while.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4744
     If the signal is ignored, and the stack continues to grow, there
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4745
     will be a few more chances (and more interrupts) before the VM
6175
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4746
     terminates the process."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4747
7838
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4748
    |con remaining sender nSkipped|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4749
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4750
    (con := thisContext) isRecursive ifFalse:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4751
"/        Processor activeProcess usedStackSize < Processor activeProcess maximumStackSize ifTrue:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4752
"/            "/ mhmh - it hit me, but I am not responsible ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4753
"/            'Stray recursionInterrupt ...' infoPrintCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4754
"/            ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4755
"/        ].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4756
        ObjectMemory infoPrinting ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4757
            'Object [info]: recursionInterrupt from:' printCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4758
            con := con sender.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4759
            remaining := 50.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4760
            [con notNil and:[remaining > 0]] whileTrue:[
7838
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4761
                sender := con sender.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4762
                '| ' print. con fullPrint.
7838
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4763
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4764
                nSkipped := 0.    
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4765
                [sender notNil and:[sender sender notNil 
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4766
                and:[sender selector == con selector
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4767
                and:[sender sender selector == con selector
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4768
                and:[sender method == con method]]]]] whileTrue:[
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4769
                    nSkipped := nSkipped + 1.    
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4770
                    con := sender.
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4771
                    sender := con sender.
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4772
                ].
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4773
                nSkipped > 0 ifTrue:[
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4774
                    '| ... ***** ' print. nSkipped print. ' recursive contexts skipped *****' printCR.
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4775
                ].
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  4776
                con := sender.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4777
                remaining := remaining - 1
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4778
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4779
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4780
        ^ RecursionInterruptSignal raiseSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4781
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4782
6175
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  4783
    "Modified: / 10.11.2001 / 15:15:56 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4784
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4785
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4786
schedulerInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4787
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4788
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4789
    "scheduler interrupt (supposed to be sent to Processor).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4790
     If we arrive here, either the Processor does not understand it,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4791
     or it has been set to nil. In any case, this is a sign of some
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4792
     big trouble. Enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4793
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4794
    self error:'schedulerInterrupt - but no Processor' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4795
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4796
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4797
signalInterrupt:signalNumber
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4798
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4799
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4800
    "unix signal occured - some signals are handled as Smalltalk Exceptions 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4801
     (SIGPIPE), others (SIGBUS) are rather fatal ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4802
     In any case, IF a smalltalk-signal has been connected to the OS signal,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4803
     that one is raised.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4804
     Otherwise, a dialog is shown, asking the user on how to handle the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4805
     signal.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4806
     TODO: add another argument, giving more detailed signal info (PC, VADDR,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4807
     exact cause etc.). This helps if segvs occur in primitive code.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4808
     Currently (temporary kludge), these are passed as global variables."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4809
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4810
    |name here sig fatal titles actions badContext msg pc addr
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4811
     action title screen|
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4812
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4813
    "if there has been an ST-signal installed, use it ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4814
    sig := OperatingSystem operatingSystemSignal:signalNumber.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4815
    sig notNil ifTrue:[
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4816
        sig raiseSignalWith:signalNumber.
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4817
        ^ self.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4818
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4819
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4820
    "/ if handled, raise OSSignalInterruptSignal
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4821
    OSSignalInterrupt isHandled ifTrue:[
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4822
        OSSignalInterrupt raiseRequestWith:signalNumber.
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4823
        ^ self.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4824
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4825
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4826
    "
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4827
     special case - SIGPWR: power failure - write a crash image and continue
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4828
                  - SIGHUP: hang up - write a crash image and exit
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  4829
    "
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  4830
    signalNumber == 30 "OperatingSystem sigPWR"  ifTrue:[
8806
03e74cded971 Make snapshot writing more robust against errors.
Stefan Vogel <sv@exept.de>
parents: 8798
diff changeset
  4831
        [ObjectMemory snapShotOn:'crash.img'] on:SnapshotError do:[:ex| ].
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4832
        ^ self.
5856
6d3df9ad361e save crash image when sigPWR or sigHUP arrives
Claus Gittinger <cg@exept.de>
parents: 5824
diff changeset
  4833
    ].
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  4834
    (signalNumber == 1 "OperatingSystem sigHUP") ifTrue:[
8806
03e74cded971 Make snapshot writing more robust against errors.
Stefan Vogel <sv@exept.de>
parents: 8798
diff changeset
  4835
        [ObjectMemory snapShotOn:'crash.img'] on:SnapshotError do:[:ex| ].
03e74cded971 Make snapshot writing more robust against errors.
Stefan Vogel <sv@exept.de>
parents: 8798
diff changeset
  4836
        Smalltalk exit:1.
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  4837
    ].
5856
6d3df9ad361e save crash image when sigPWR or sigHUP arrives
Claus Gittinger <cg@exept.de>
parents: 5824
diff changeset
  4838
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4839
    name := OperatingSystem nameForSignal:signalNumber.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4840
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4841
    "if there is no screen at all, bring up a mini debugger"
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4842
    (Screen isNil 
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4843
     or:[(screen := Screen current) isNil
6778
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  4844
     or:[(screen := Screen default) isNil
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  4845
     or:[screen isOpen not]]]) ifTrue:[
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4846
        ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4847
    ].
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4848
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4849
    "ungrab - in case it happened in a box/popupview
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4850
     otherwise display stays locked"
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4851
    screen ungrabPointer; ungrabKeyboard.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4852
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  4853
    here := thisContext.
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  4854
    badContext := here sender.          "the context, in which the signal occurred"
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  4855
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4856
    "there is a screen. use it to bring up a box asking for what to do ..."
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4857
    Screen currentScreenQuerySignal answer:screen do:[
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4858
        "
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4859
         SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4860
         since the system will retry the faulty instruction, which leads to
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4861
         another signal - to avoid frustration, better not offer this option.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4862
        "
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4863
        fatal := OperatingSystem isFatalSignal:signalNumber.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4864
        fatal ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4865
            (Debugger isNil or:[here isRecursive]) ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4866
                'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR.
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4867
                ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4868
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4869
            "
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4870
             a hard signal - go into debugger immediately
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4871
            "
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4872
            msg := 'OS-signal: ', name.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4873
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4874
            "/ the IRQ-PC is passed as low-hi, to avoid the need
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4875
            "/ to allocate a LargeInteger in the VM during signal
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4876
            "/ time. I know, this is ugly.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4877
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4878
            InterruptPcLow notNil ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4879
                pc := InterruptPcLow + (InterruptPcHi bitShift:(SmallInteger maxBits + 1 // 2)).
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4880
                pc ~~ 0 ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4881
                    msg := msg , ' PC=' , (pc printStringRadix:16)
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4882
                ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4883
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4884
            InterruptAddrLow notNil ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4885
                addr := InterruptAddrLow + (InterruptAddrHi bitShift:(SmallInteger maxBits + 1 // 2)).
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4886
                addr ~~ 0 ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4887
                    msg := msg , ' ADDR=' , (addr printStringRadix:16)
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4888
                ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4889
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4890
            Debugger enter:here withMessage:msg mayProceed:false.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4891
            "unreachable"
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4892
            ^ nil.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4893
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4894
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4895
        "if possible, open an option box asking the user what do.       
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4896
         Otherwise, start a debugger"
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4897
        Dialog notNil ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4898
            titles := #('save crash image' 'dump core' 'exit ST/X' 'debug').
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4899
            actions := #(save core exit debug).
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4900
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4901
            action := nil.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4902
            title := 'OS Signal caught (' , name, ')'.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4903
            title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4904
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4905
            "/ if cought while in the scheduler or event dispatcher,
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4906
            "/ a modal dialog is not possible ...
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4907
            "/ (therefore, abort & return does not makes sense)
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4908
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4909
            Processor activeProcess isSystemProcess ifFalse:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4910
                titles := #('abort') , titles.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4911
                actions := #(abort), actions. 
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4912
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4913
                badContext canReturn ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4914
                    titles := #('return') , titles.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4915
                    actions :=  #(return), actions.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4916
                ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4917
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4918
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4919
            fatal ifFalse:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4920
                titles := titles, #('ignore').
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4921
                actions := actions , #(ignore).
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4922
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4923
            action := Dialog choose:title
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4924
                             labels:titles
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4925
                             values:actions
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4926
                             default:(fatal ifTrue:[nil] ifFalse:[#ignore]).
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4927
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4928
            "Dialog may fail (if system process), default action is debug"
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4929
            action size == 0 ifTrue:[action := #debug].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4930
        ] ifFalse:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4931
            action := #debug.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4932
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4933
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4934
        action == #save ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4935
            ObjectMemory snapShotOn:'crash.img'
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4936
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4937
        action == #core ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4938
            Smalltalk fatalAbort
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4939
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4940
        action == #exit ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4941
            Smalltalk exit
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4942
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4943
        action == #return ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4944
            badContext return
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4945
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4946
        action == #abort ifTrue:[
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4947
            AbortOperationRequest raise.
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4948
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4949
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4950
        action == #debug ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4951
            Debugger isNil ifTrue:[
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4952
                ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4953
            ].
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4954
            Debugger enter:here withMessage:('OS-Signal ', name) mayProceed:true. 
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4955
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  4956
        "action == #ignore"
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4957
    ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4958
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4959
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4960
spyInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4961
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4962
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4963
    "spy interrupt and no handler - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4964
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4965
    self error:'spy Interrupt - but no handler' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4966
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4967
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4968
startMiniDebuggerOrExit:text
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4969
    "some critical condition happened.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4970
     Start a mini debugger or exit if none is present"
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4971
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4972
    MiniDebugger isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4973
        "a system without debugging facilities (i.e. a standalone system)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4974
         output a message and exit."
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4975
        ('Object [error]: exit due to ', text, ' - and no debugger.') errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4976
        OperatingSystem exit:99.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4977
    ].
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4978
    MiniDebugger enterWithMessage:text mayProceed:true.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4979
!
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  4980
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4981
timerInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4982
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4983
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4984
    "timer interrupt and no handler - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4985
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4986
    self error:'timer Interrupt - but no handler' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4987
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4988
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4989
userInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4990
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4991
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4992
    "user (^c) interrupt.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4993
     This is typically sent by the VM, when a ctrl-C is typed at the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4994
     controlling tty (i.e. in the xterm)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4995
6466
ae28dd895a58 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6461
diff changeset
  4996
    UserInterruptSignal raiseRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4997
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4998
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4999
userInterruptIn:aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5000
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5001
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5002
    "user (^c) interrupt - enter debugger, but show aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5003
     as top-context. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5004
     This is used to hide any intermediate scheduler contexts, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5005
     in case of an interrupted process. Typically, this is sent by
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5006
     the WindowGroup, when a keyboardEvent for the ctrl-C key is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5007
     processed."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5008
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5009
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5010
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5011
    UserInterruptSignal raiseRequestWith:nil errorString:nil in:aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5012
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5013
    "Created: / 18.10.1996 / 20:46:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5014
    "Modified: / 20.10.1996 / 13:06:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5015
    "Modified: / 26.7.1999 / 10:58:49 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5016
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5017
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5018
!Object methodsFor:'message sending'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5019
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5020
perform:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5021
    "send the message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5022
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5023
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5024
    REGISTER OBJ sel = aSelector;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5025
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5026
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5027
        struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5028
        static struct inlineCache ilc_0 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5029
        static struct inlineCache ilc_1 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5030
        static struct inlineCache ilc_2 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5031
        static struct inlineCache ilc_3 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5032
        static struct inlineCache ilc_4 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5033
        static OBJ last_0 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5034
        static OBJ last_1 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5035
        static OBJ last_2 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5036
        static OBJ last_3 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5037
        static OBJ last_4 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5038
        static flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5039
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5040
        if (sel == last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5041
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5042
        } else if (sel == last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5043
            pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5044
        } else if (sel == last_2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5045
            pIlc = &ilc_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5046
        } else if (sel == last_3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5047
            pIlc = &ilc_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5048
        } else if (sel == last_4) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5049
            pIlc = &ilc_4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5050
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5051
            if (flip == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5052
                pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5053
                flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5054
                last_0 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5055
            } else if (flip == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5056
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5057
                flip = 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5058
                last_1 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5059
            } else if (flip == 2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5060
                pIlc = &ilc_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5061
                flip = 3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5062
                last_2 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5063
            } else if (flip == 3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5064
                pIlc = &ilc_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5065
                flip = 4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5066
                last_3 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5067
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5068
                pIlc = &ilc_4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5069
                flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5070
                last_4 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5071
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5072
            pIlc->ilc_func = __SEND0ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5073
            if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5074
                __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5075
                pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5076
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5077
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5078
        RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5079
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5080
        static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5081
        RETURN (_SEND0(self, aSelector, nil, &ilc0));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5082
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5083
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5084
    ^ self perform:aSelector withArguments:#()
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5085
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5086
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5087
perform:aSelector inClass:aClass withArguments:argArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5088
    "send the message aSelector with all args taken from argArray 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5089
     to the receiver as a super-send message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5090
     This is actually more flexible than the normal super-send, since it allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5091
     to execute a method in ANY superclass of the receiver (not just the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5092
     immediate superclass).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5093
     Thus, it is (theoretically) possible to do 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5094
         '5 perform:#< inClass:Magnitude withArguments:#(6)'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5095
     and evaluate Magnitudes compare method even if there was one in Number.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5096
     This method is used by the interpreter to evaluate super sends
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5097
     and could be used for very special behavior (language extension ?).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5098
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5099
     WARNING: this is an ST/X feature - probably not found in other smalltalks."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5100
5769
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5101
    |numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 myClass|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5102
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5103
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5104
     check, if aClass is really a superclass of the receiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5105
    "
5769
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5106
    myClass := self class.
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5107
    (myClass == aClass or:[myClass isSubclassOf:aClass]) ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5108
        self error:'lookup-class argument is not a superclass of the receiver'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5109
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5110
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5111
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5112
    REGISTER OBJ *argP;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5113
    int nargs, i;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5114
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  5115
    if (__isArrayLike(argArray)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5116
        nargs = __arraySize(argArray);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5117
        argP = __arrayVal(argArray);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5118
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5119
        if (__isNonNilObject(argArray)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5120
            static struct inlineCache ilcSize = __ILC0(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5121
            numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize); 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5122
            if (!__isSmallInteger(numberOfArgs)) 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5123
                goto bad;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5124
            nargs = __intVal(numberOfArgs);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5125
            argP = (OBJ *)(&a1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5126
            for (i=1; i <= nargs; i++) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  5127
                *argP++ = __AT_(argArray, __mkSmallInteger(i));
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5128
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5129
            argP = (OBJ *)(&a1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5130
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5131
            nargs = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5132
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5133
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5134
    switch (nargs) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5135
        case 0:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5136
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5137
                static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5138
                RETURN ( _SEND0(self, aSelector, aClass, &ilc0));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5139
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5140
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5141
        case 1: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5142
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5143
                static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5144
                RETURN ( _SEND1(self, aSelector, aClass, &ilc1, argP[0]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5145
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5146
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5147
        case 2: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5148
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5149
                static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5150
                RETURN ( _SEND2(self, aSelector, aClass, &ilc2, argP[0], argP[1]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5151
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5152
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5153
        case 3: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5154
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5155
                static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5156
                RETURN ( _SEND3(self, aSelector, aClass, &ilc3, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5157
                                argP[0], argP[1], argP[2]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5158
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5159
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5160
        case 4: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5161
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5162
                static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5163
                RETURN ( _SEND4(self, aSelector, aClass, &ilc4,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5164
                                argP[0], argP[1], argP[2], argP[3]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5165
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5166
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5167
        case 5: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5168
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5169
                static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5170
                RETURN ( _SEND5(self, aSelector, aClass, &ilc5, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5171
                                argP[0], argP[1], argP[2], argP[3], argP[4]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5172
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5173
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5174
        case 6: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5175
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5176
                static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5177
                RETURN ( _SEND6(self, aSelector, aClass, &ilc6, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5178
                                argP[0], argP[1], argP[2], argP[3], argP[4], argP[5]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5179
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5180
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5181
        case 7: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5182
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5183
                static struct inlineCache ilc7 = __DUMMYILCSELF7(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5184
                RETURN ( _SEND7(self, aSelector, aClass, &ilc7, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5185
                                argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5186
                                argP[6]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5187
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5188
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5189
        case 8: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5190
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5191
                static struct inlineCache ilc8 = __DUMMYILCSELF8(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5192
                RETURN ( _SEND8(self, aSelector, aClass, &ilc8, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5193
                                argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5194
                                argP[6], argP[7]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5195
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5196
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5197
        case 9: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5198
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5199
                static struct inlineCache ilc9 = __DUMMYILCSELF9(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5200
                RETURN ( _SEND9(self, aSelector, aClass, &ilc9, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5201
                                argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5202
                                argP[6], argP[7], argP[8]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5203
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5204
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5205
        case 10: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5206
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5207
                static struct inlineCache ilc10 = __DUMMYILCSELF10(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5208
                RETURN ( _SEND10(self, aSelector, aClass, &ilc10, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5209
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5210
                                 argP[6], argP[7], argP[8], argP[9]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5211
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5212
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5213
        case 11: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5214
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5215
                static struct inlineCache ilc11 = __DUMMYILCSELF11(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5216
                RETURN ( _SEND11(self, aSelector, aClass, &ilc11, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5217
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5218
                                 argP[6], argP[7], argP[8], argP[9], argP[10]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5219
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5220
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5221
        case 12: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5222
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5223
                static struct inlineCache ilc12 = __DUMMYILCSELF12(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5224
                RETURN ( _SEND12(self, aSelector, aClass, &ilc12, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5225
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5226
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5227
                                 argP[11]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5228
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5229
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5230
        case 13: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5231
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5232
                static struct inlineCache ilc13 = __DUMMYILCSELF13(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5233
                RETURN ( _SEND13(self, aSelector, aClass, &ilc13, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5234
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5235
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5236
                                 argP[11], argP[12]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5237
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5238
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5239
        case 14: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5240
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5241
                static struct inlineCache ilc14 = __DUMMYILCSELF14(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5242
                RETURN ( _SEND14(self, aSelector, aClass, &ilc14, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5243
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5244
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5245
                                 argP[11], argP[12], argP[13]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5246
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5247
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5248
        case 15: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5249
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5250
                static struct inlineCache ilc15 = __DUMMYILCSELF15(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5251
                RETURN ( _SEND15(self, aSelector, aClass, &ilc15, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5252
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5253
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5254
                                 argP[11], argP[12], argP[13], argP[14]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5255
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5256
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5257
#ifdef _SEND16
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5258
        case 16:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5259
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5260
                static struct inlineCache ilc16 = __DUMMYILCSELF16(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5261
                RETURN ( _SEND16(self, aSelector, aClass, &ilc15,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5262
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5263
                                 argP[6], argP[7], argP[8], argP[9], argP[10],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5264
                                 argP[11], argP[12], argP[13], argP[14], argP[15]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5265
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5266
#endif
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5267
#ifdef _SEND17
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5268
        case 17:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5269
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5270
                static struct inlineCache ilc17 = __DUMMYILCSELF17(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5271
                RETURN ( _SEND17(self, aSelector, aClass, &ilc15,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5272
                                 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5273
                                 argP[6], argP[7], argP[8], argP[9], argP[10],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5274
                                 argP[11], argP[12], argP[13], argP[14], argP[15], argP[16]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5275
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5276
#endif
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5277
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5278
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5279
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5280
bad:;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5281
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5282
    "/ arrive here, if bad number of arguments (too many)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5283
    "/ ST/X (currently) only allows up to 15 method arguments
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5284
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5285
    ^ self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5286
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5287
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5288
perform:aSelector with:arg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5289
    "send the one-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5290
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5291
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5292
    REGISTER OBJ sel = aSelector;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5293
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5294
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5295
        struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5296
        static struct inlineCache ilc_0 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5297
        static struct inlineCache ilc_1 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5298
        static struct inlineCache ilc_2 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5299
        static struct inlineCache ilc_3 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5300
        static struct inlineCache ilc_4 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5301
        static OBJ last_0 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5302
        static OBJ last_1 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5303
        static OBJ last_2 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5304
        static OBJ last_3 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5305
        static OBJ last_4 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5306
        static flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5307
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5308
        if (sel == last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5309
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5310
        } else if (sel == last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5311
            pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5312
        } else if (sel == last_2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5313
            pIlc = &ilc_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5314
        } else if (sel == last_3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5315
            pIlc = &ilc_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5316
        } else if (sel == last_4) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5317
            pIlc = &ilc_4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5318
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5319
            if (flip == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5320
                pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5321
                flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5322
                last_0 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5323
            } else if (flip == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5324
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5325
                flip = 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5326
                last_1 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5327
            } else if (flip == 2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5328
                pIlc = &ilc_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5329
                flip = 3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5330
                last_2 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5331
            } else if (flip == 3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5332
                pIlc = &ilc_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5333
                flip = 4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5334
                last_3 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5335
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5336
                pIlc = &ilc_4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5337
                flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5338
                last_4 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5339
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5340
            pIlc->ilc_func = __SEND1ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5341
            if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5342
                __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5343
                pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5344
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5345
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5346
        RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5347
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5348
        static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5349
        RETURN (_SEND1(self, aSelector, nil, &ilc1, arg));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5350
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5351
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5352
    ^ self perform:aSelector withArguments:(Array with:arg)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5353
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5354
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5355
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5356
perform:aSelector with:arg1 with:arg2
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5357
    "send the two-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5358
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5359
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5360
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5361
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5362
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5363
        static struct inlineCache ilc_0 = __ILCPERF2(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5364
        static struct inlineCache ilc_1 = __ILCPERF2(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5365
        static OBJ last_0 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5366
        static OBJ last_1 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5367
        static flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5368
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5369
        if (aSelector == last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5370
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5371
        } else if (aSelector == last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5372
            pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5373
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5374
            if (flip == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5375
                pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5376
                flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5377
                last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5378
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5379
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5380
                flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5381
                last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5382
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5383
            pIlc->ilc_func = __SEND2ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5384
            if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5385
                __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5386
                pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5387
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5388
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5389
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5390
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5391
        static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5392
        RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5393
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5394
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5395
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5396
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5397
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5398
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5399
perform:aSelector with:arg1 with:arg2 with:arg3
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5400
    "send the three-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5401
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5402
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5403
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5404
    static struct inlineCache ilc_0 = __ILCPERF3(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5405
    static struct inlineCache ilc_1 = __ILCPERF3(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5406
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5407
    static OBJ last_1 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5408
    static flip = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5409
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5410
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5411
        if (aSelector != last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5412
            if (aSelector != last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5413
                if (flip) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5414
                    pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5415
                    flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5416
                    last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5417
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5418
                    pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5419
                    flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5420
                    last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5421
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5422
                pIlc->ilc_func = __SEND3ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5423
                if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5424
                    __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5425
                    pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5426
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5427
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5428
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5429
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5430
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5431
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5432
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5433
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2, arg3) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5434
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5435
        static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5436
        RETURN (_SEND3(self, aSelector, nil, &ilc3, arg1, arg2, arg3));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5437
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5438
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5439
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5440
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5441
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5442
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5443
perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5444
    "send the four-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5445
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5446
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5447
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5448
    static struct inlineCache ilc_0 = __ILCPERF4(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5449
    static struct inlineCache ilc_1 = __ILCPERF4(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5450
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5451
    static OBJ last_1 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5452
    static flip = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5453
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5454
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5455
        if (aSelector != last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5456
            if (aSelector != last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5457
                if (flip) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5458
                    pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5459
                    flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5460
                    last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5461
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5462
                    pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5463
                    flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5464
                    last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5465
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5466
                pIlc->ilc_func = __SEND4ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5467
                if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5468
                    __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5469
                    pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5470
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5471
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5472
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5473
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5474
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5475
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5476
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5477
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5478
                                     arg1, arg2, arg3, arg4) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5479
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5480
        static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5481
        RETURN (_SEND4(self, aSelector, nil, &ilc4,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5482
                       arg1, arg2, arg3, arg4));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5483
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5484
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5485
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5486
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5487
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5488
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5489
perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4 with:arg5
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5490
    "send the five-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5491
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5492
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5493
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5494
    static struct inlineCache ilc_0 = __ILCPERF5(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5495
    static struct inlineCache ilc_1 = __ILCPERF5(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5496
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5497
    static OBJ last_1 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5498
    static flip = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5499
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5500
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5501
        if (aSelector != last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5502
            if (aSelector != last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5503
                if (flip) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5504
                    pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5505
                    flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5506
                    last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5507
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5508
                    pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5509
                    flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5510
                    last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5511
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5512
                pIlc->ilc_func = __SEND5ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5513
                if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5514
                    __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5515
                    pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5516
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5517
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5518
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5519
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5520
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5521
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5522
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5523
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5524
                                     arg1, arg2, arg3, arg4, arg5) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5525
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5526
        static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5527
        RETURN (_SEND5(self, aSelector, nil, &ilc5,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5528
                       arg1, arg2, arg3, arg4, arg5));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5529
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5530
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5531
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5532
                                                  with:arg5)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5533
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5534
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5535
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5536
perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4 with:arg5 with:arg6
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5537
    "send the six-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5538
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5539
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5540
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5541
    static struct inlineCache ilc_0 = __ILCPERF6(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5542
    static struct inlineCache ilc_1 = __ILCPERF6(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5543
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5544
    static OBJ last_1 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5545
    static flip = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5546
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5547
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5548
        if (aSelector != last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5549
            if (aSelector != last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5550
                if (flip) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5551
                    pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5552
                    flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5553
                    last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5554
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5555
                    pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5556
                    flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5557
                    last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5558
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5559
                pIlc->ilc_func = __SEND6ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5560
                if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5561
                    __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5562
                    pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5563
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5564
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5565
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5566
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5567
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5568
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5569
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5570
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5571
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5572
                                     arg1, arg2, arg3, arg4, arg5, arg6) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5573
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5574
        static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5575
        RETURN (_SEND6(self, aSelector, nil, &ilc6,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5576
                       arg1, arg2, arg3, arg4, arg5, arg6));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5577
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5578
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5579
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5580
                                                  with:arg5 with:arg6)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5581
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5582
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5583
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5584
perform:aSelector withArguments:argArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5585
    "send the message aSelector with all args taken from argArray 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5586
     to the receiver."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5587
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5588
    |numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5589
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5590
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5591
    REGISTER OBJ *argP;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5592
    int nargs;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5593
    OBJ l;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5594
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  5595
    if (__isArrayLike(argArray)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5596
        nargs = __arraySize(argArray);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5597
        argP = __arrayVal(argArray);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5598
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5599
        if (__isNonNilObject(argArray)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5600
            static struct inlineCache ilcSize = __ILC0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5601
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5602
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5603
            numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize); 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5604
            if (!__isSmallInteger(numberOfArgs)) 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5605
                goto bad;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5606
            nargs = __intVal(numberOfArgs);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5607
            argP = (OBJ *)(&a1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5608
            for (i=1; i <= nargs; i++) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  5609
                *argP++ = __AT_(argArray, __mkSmallInteger(i));
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5610
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5611
            argP = (OBJ *)(&a1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5612
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5613
            nargs = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5614
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5615
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5616
    switch (nargs) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5617
        case 0:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5618
            if (InterruptPending == nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5619
                static OBJ last0_0 = nil; static struct inlineCache ilc0_0 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5620
                static OBJ last0_1 = nil; static struct inlineCache ilc0_1 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5621
                static OBJ last0_2 = nil; static struct inlineCache ilc0_2 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5622
                static OBJ last0_3 = nil; static struct inlineCache ilc0_3 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5623
                static int flip0 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5624
                struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5625
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5626
                if (aSelector == last0_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5627
                    pIlc = &ilc0_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5628
                } else if (aSelector == last0_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5629
                    pIlc = &ilc0_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5630
                } else if (aSelector == last0_2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5631
                    pIlc = &ilc0_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5632
                } else if (aSelector == last0_3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5633
                    pIlc = &ilc0_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5634
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5635
                    if (flip0 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5636
                        pIlc = &ilc0_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5637
                        flip0 = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5638
                        last0_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5639
                    } else if (flip0 == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5640
                        pIlc = &ilc0_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5641
                        flip0 = 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5642
                        last0_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5643
                    } else if (flip0 == 2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5644
                        pIlc = &ilc0_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5645
                        flip0 = 3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5646
                        last0_2 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5647
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5648
                        pIlc = &ilc0_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5649
                        flip0 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5650
                        last0_3 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5651
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5652
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5653
                    pIlc->ilc_func = __SEND0ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5654
                    if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5655
                        __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5656
                        pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5657
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5658
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5659
                RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5660
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5661
                static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5662
                RETURN (_SEND0(self, aSelector, nil, &ilc0));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5663
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5664
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5665
        case 1: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5666
            if (InterruptPending == nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5667
                static OBJ last1_0 = nil; static struct inlineCache ilc1_0 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5668
                static OBJ last1_1 = nil; static struct inlineCache ilc1_1 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5669
                static OBJ last1_2 = nil; static struct inlineCache ilc1_2 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5670
                static OBJ last1_3 = nil; static struct inlineCache ilc1_3 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5671
                static int flip1 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5672
                struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5673
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5674
                if (aSelector == last1_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5675
                    pIlc = &ilc1_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5676
                } else if (aSelector == last1_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5677
                    pIlc = &ilc1_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5678
                } else if (aSelector == last1_2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5679
                    pIlc = &ilc1_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5680
                } else if (aSelector == last1_3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5681
                    pIlc = &ilc1_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5682
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5683
                    if (flip1 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5684
                        pIlc = &ilc1_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5685
                        flip1 = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5686
                        last1_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5687
                    } else if (flip1 == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5688
                        pIlc = &ilc1_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5689
                        flip1 = 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5690
                        last1_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5691
                    } else if (flip1 == 2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5692
                        pIlc = &ilc1_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5693
                        flip1 = 3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5694
                        last1_2 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5695
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5696
                        pIlc = &ilc1_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5697
                        flip1 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5698
                        last1_3 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5699
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5700
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5701
                    pIlc->ilc_func = __SEND1ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5702
                    if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5703
                        __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5704
                        pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5705
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5706
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5707
                RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5708
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5709
                static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5710
                RETURN (_SEND1(self, aSelector, nil, &ilc1, argP[0]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5711
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5712
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5713
        case 2: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5714
            if (InterruptPending == nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5715
                static OBJ last2_0 = nil; static struct inlineCache ilc2_0 = __ILCPERF2(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5716
                static OBJ last2_1 = nil; static struct inlineCache ilc2_1 = __ILCPERF2(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5717
                static int flip2 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5718
                struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5719
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5720
                if (aSelector == last2_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5721
                    pIlc = &ilc2_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5722
                } else if (aSelector == last2_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5723
                    pIlc = &ilc2_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5724
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5725
                    if (flip2 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5726
                        pIlc = &ilc2_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5727
                        flip2 = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5728
                        last2_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5729
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5730
                        pIlc = &ilc2_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5731
                        flip2 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5732
                        last2_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5733
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5734
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5735
                    pIlc->ilc_func = __SEND2ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5736
                    if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5737
                        __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5738
                        pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5739
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5740
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5741
                RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5742
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5743
                static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5744
                RETURN (_SEND2(self, aSelector, nil, &ilc2, argP[0], argP[1]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5745
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5746
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5747
        case 3: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5748
            if (InterruptPending == nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5749
                static OBJ last3_0 = nil; static struct inlineCache ilc3_0 = __ILCPERF3(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5750
                static OBJ last3_1 = nil; static struct inlineCache ilc3_1 = __ILCPERF3(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5751
                static int flip3 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5752
                struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5753
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5754
                if (aSelector == last3_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5755
                    pIlc = &ilc3_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5756
                } else if (aSelector == last3_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5757
                    pIlc = &ilc3_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5758
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5759
                    if (flip3 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5760
                        pIlc = &ilc3_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5761
                        flip3 = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5762
                        last3_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5763
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5764
                        pIlc = &ilc3_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5765
                        flip3 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5766
                        last3_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5767
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5768
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5769
                    pIlc->ilc_func = __SEND3ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5770
                    if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5771
                        __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5772
                        pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5773
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5774
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5775
                RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1], argP[2]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5776
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5777
                static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5778
                RETURN (_SEND3(self, aSelector, nil, &ilc3, argP[0], argP[1], argP[2]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5779
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5780
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5781
        case 4: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5782
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5783
                static OBJ last4 = nil; static struct inlineCache ilc4 = __ILCPERF4(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5784
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5785
                if ((InterruptPending != nil) || (aSelector != last4)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5786
                    ilc4.ilc_func = __SEND4ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5787
                    if (ilc4.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5788
                        __flushPolyCache(ilc4.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5789
                        ilc4.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5790
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5791
                    last4 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5792
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5793
                RETURN ( (*ilc4.ilc_func)(self, aSelector, nil, &ilc4,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5794
                                                argP[0], argP[1], argP[2], argP[3]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5795
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5796
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5797
        case 5: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5798
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5799
                static OBJ last5 = nil; static struct inlineCache ilc5 = __ILCPERF5(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5800
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5801
                if ((InterruptPending != nil) || (aSelector != last5)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5802
                    ilc5.ilc_func = __SEND5ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5803
                    if (ilc5.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5804
                        __flushPolyCache(ilc5.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5805
                        ilc5.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5806
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5807
                    last5 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5808
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5809
                RETURN ( (*ilc5.ilc_func)(self, aSelector, nil, &ilc5, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5810
                                                argP[0], argP[1], argP[2], argP[3], argP[4]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5811
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5812
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5813
        case 6: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5814
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5815
                static OBJ last6 = nil; static struct inlineCache ilc6 = __ILCPERF6(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5816
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5817
                if ((InterruptPending != nil) || (aSelector != last6)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5818
                    ilc6.ilc_func = __SEND6ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5819
                    if (ilc6.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5820
                        __flushPolyCache(ilc6.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5821
                        ilc6.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5822
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5823
                    last6 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5824
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5825
                RETURN ( (*ilc6.ilc_func)(self, aSelector, nil, &ilc6, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5826
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5827
                                                argP[5]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5828
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5829
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5830
        case 7: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5831
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5832
                static OBJ last7 = nil; static struct inlineCache ilc7 = __ILCPERF7(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5833
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5834
                if ((InterruptPending != nil) || (aSelector != last7)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5835
                    ilc7.ilc_func = __SEND7ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5836
                    if (ilc7.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5837
                        __flushPolyCache(ilc7.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5838
                        ilc7.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5839
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5840
                    last7 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5841
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5842
                RETURN ( (*ilc7.ilc_func)(self, aSelector, nil, &ilc7, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5843
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5844
                                                argP[5], argP[6]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5845
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5846
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5847
        case 8:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5848
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5849
                static OBJ last8 = nil; static struct inlineCache ilc8 = __ILCPERF8(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5850
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5851
                if ((InterruptPending != nil) || (aSelector != last8)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5852
                    ilc8.ilc_func = __SEND8ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5853
                    if (ilc8.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5854
                        __flushPolyCache(ilc8.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5855
                        ilc8.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5856
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5857
                    last8 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5858
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5859
                RETURN ( (*ilc8.ilc_func)(self, aSelector, nil, &ilc8, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5860
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5861
                                                argP[5], argP[6], argP[7]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5862
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5863
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5864
        case 9: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5865
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5866
                static OBJ last9 = nil; static struct inlineCache ilc9 = __ILCPERF9(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5867
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5868
                if ((InterruptPending != nil) || (aSelector != last9)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5869
                    ilc9.ilc_func = __SEND9ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5870
                    if (ilc9.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5871
                        __flushPolyCache(ilc9.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5872
                        ilc9.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5873
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5874
                    last9 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5875
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5876
                RETURN ( (*ilc9.ilc_func)(self, aSelector, nil, &ilc9, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5877
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5878
                                                argP[5], argP[6], argP[7], argP[8]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5879
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5880
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5881
        case 10: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5882
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5883
                static OBJ last10 = nil; static struct inlineCache ilc10 = __ILCPERF10(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5884
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5885
                if ((InterruptPending != nil) || (aSelector != last10)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5886
                    ilc10.ilc_func = __SEND10ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5887
                    if (ilc10.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5888
                        __flushPolyCache(ilc10.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5889
                        ilc10.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5890
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5891
                    last10 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5892
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5893
                RETURN ( (*ilc10.ilc_func)(self, aSelector, nil, &ilc10, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5894
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5895
                                                argP[5], argP[6], argP[7], argP[8], argP[9]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5896
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5897
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5898
        case 11: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5899
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5900
                static OBJ last11 = nil; static struct inlineCache ilc11 = __ILCPERF11(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5901
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5902
                if ((InterruptPending != nil) || (aSelector != last11)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5903
                    ilc11.ilc_func = __SEND11ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5904
                    if (ilc11.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5905
                        __flushPolyCache(ilc11.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5906
                        ilc11.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5907
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5908
                    last11 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5909
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5910
                RETURN ( (*ilc11.ilc_func)(self, aSelector, nil, &ilc11, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5911
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5912
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5913
                                                argP[10]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5914
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5915
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5916
        case 12: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5917
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5918
                static OBJ last12 = nil; static struct inlineCache ilc12 = __ILCPERF12(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5919
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5920
                if ((InterruptPending != nil) || (aSelector != last12)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5921
                    ilc12.ilc_func = __SEND12ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5922
                    if (ilc12.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5923
                        __flushPolyCache(ilc12.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5924
                        ilc12.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5925
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5926
                    last12 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5927
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5928
                RETURN ( (*ilc12.ilc_func)(self, aSelector, nil, &ilc12, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5929
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5930
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5931
                                                argP[10], argP[11]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5932
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5933
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5934
        case 13: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5935
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5936
                static OBJ last13 = nil; static struct inlineCache ilc13 = __ILCPERF13(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5937
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5938
                if ((InterruptPending != nil) || (aSelector != last13)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5939
                    ilc13.ilc_func = __SEND13ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5940
                    if (ilc13.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5941
                        __flushPolyCache(ilc13.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5942
                        ilc13.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5943
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5944
                    last13 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5945
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5946
                RETURN ( (*ilc13.ilc_func)(self, aSelector, nil, &ilc13, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5947
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5948
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5949
                                                argP[10], argP[11], argP[12]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5950
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5951
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5952
        case 14: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5953
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5954
                static OBJ last14 = nil; static struct inlineCache ilc14 = __ILCPERF14(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5955
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5956
                if ((InterruptPending != nil) || (aSelector != last14)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5957
                    ilc14.ilc_func = __SEND14ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5958
                    if (ilc14.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5959
                        __flushPolyCache(ilc14.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5960
                        ilc14.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5961
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5962
                    last14 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5963
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5964
                RETURN ( (*ilc14.ilc_func)(self, aSelector, nil, &ilc14, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5965
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5966
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5967
                                                argP[10], argP[11], argP[12], argP[13]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5968
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5969
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5970
        case 15: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5971
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5972
                static OBJ last15 = nil; static struct inlineCache ilc15 = __ILCPERF15(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5973
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5974
                if ((InterruptPending != nil) || (aSelector != last15)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5975
                    ilc15.ilc_func = __SEND15ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5976
                    if (ilc15.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5977
                        __flushPolyCache(ilc15.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5978
                        ilc15.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5979
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5980
                    last15 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5981
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5982
                RETURN ( (*ilc15.ilc_func)(self, aSelector, nil, &ilc15, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5983
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5984
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5985
                                                argP[10], argP[11], argP[12], argP[13],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5986
                                                argP[14]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5987
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5988
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5989
bad:;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5990
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5991
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5992
    "/ arrive here, if bad number of arguments (too many)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5993
    "/ ST/X (currently) only allows up to 15 method arguments
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5994
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5995
    ^ self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5996
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5997
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  5998
perform:aSelector withOptionalArgument:arg
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  5999
    "send aSelector-message to the receiver.
6318
3677d346113a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6316
diff changeset
  6000
     If the message expects an argument, pass arg."
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6001
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6002
    aSelector numArgs == 1 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6003
        ^ self perform:aSelector with:arg
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6004
    ].
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6005
    ^ self perform:aSelector
6319
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6006
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6007
    "
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6008
     |rec sel|
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6009
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6010
     rec := -1.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6011
     sel := #abs.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6012
     rec perform:sel withOptionalArgument:2.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6013
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6014
     sel := #max:.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6015
     rec perform:sel withOptionalArgument:2.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6016
    "
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6017
!
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6018
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6019
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6020
    "send aSelector-message to the receiver.
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6021
     Depending on the number of arguments the message expects,
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6022
     pass either none, 1, or 2 arguments."
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6023
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6024
    |numArgs|
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6025
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6026
    numArgs := aSelector numArgs.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6027
    numArgs == 0 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6028
        ^ self perform:aSelector
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6029
    ].
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6030
    numArgs == 1 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6031
        ^ self perform:aSelector with:optionalArg1
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6032
    ].
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6033
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6034
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6035
    "
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6036
     |rec sel|
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6037
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6038
     rec := -1.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6039
     sel := #abs.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6040
     rec perform:sel withOptionalArgument:2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6041
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6042
     sel := #max:.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6043
     rec perform:sel withOptionalArgument:2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6044
    "
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6045
!
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6046
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6047
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2 and:optionalArg3
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6048
    "send aSelector-message to the receiver.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6049
     Depending on the number of arguments the message expects,
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6050
     pass either none, 1, 2 or 3 arguments."
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6051
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6052
    |numArgs|
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6053
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6054
    numArgs := aSelector numArgs.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6055
    numArgs == 0 ifTrue:[
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6056
        ^ self perform:aSelector
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6057
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6058
    numArgs == 1 ifTrue:[
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6059
        ^ self perform:aSelector with:optionalArg1
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6060
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6061
    numArgs == 2 ifTrue:[
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6062
        ^ self perform:aSelector with:optionalArg1 with:optionalArg2
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6063
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6064
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6065
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6066
    "
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6067
     |rec sel|
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6068
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6069
     rec := -1.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6070
     sel := #abs.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6071
     rec perform:sel withOptionalArgument:2.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6072
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6073
     sel := #max:.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6074
     rec perform:sel withOptionalArgument:2.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6075
    "
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6076
!
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6077
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6078
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2 and:optionalArg3 and:optionalArg4
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6079
    "send aSelector-message to the receiver.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6080
     Depending on the number of arguments the message expects,
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6081
     pass either none, 1, 2, 3 or 4 arguments."
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6082
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6083
    |numArgs|
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6084
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6085
    numArgs := aSelector numArgs.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6086
    numArgs == 0 ifTrue:[
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6087
        ^ self perform:aSelector
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6088
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6089
    numArgs == 1 ifTrue:[
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6090
        ^ self perform:aSelector with:optionalArg1
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6091
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6092
    numArgs == 2 ifTrue:[
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6093
        ^ self perform:aSelector with:optionalArg1 with:optionalArg2
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6094
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6095
    numArgs == 3 ifTrue:[
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6096
        ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6097
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6098
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3 with:optionalArg4.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6099
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6100
    "
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6101
     |rec sel|
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6102
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6103
     rec := -1.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6104
     sel := #abs.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6105
     rec perform:sel withOptionalArgument:2.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6106
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6107
     sel := #max:.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6108
     rec perform:sel withOptionalArgument:2.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6109
    "
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6110
!
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6111
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6112
performMethod:aMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6113
    "invoke aMethod on the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6114
     The method should be a zero-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6115
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6116
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6117
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6118
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6119
         receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6120
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6121
    ^ aMethod valueWithReceiver:self arguments:#()
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6122
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6123
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6124
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6125
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6126
     mthd := SmallInteger compiledMethodAt:#negated.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6127
     Transcript showCR:(1 performMethod:mthd)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6128
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6129
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6130
    "BAD USE example:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6131
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6132
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6133
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6134
     mthd := Point compiledMethodAt:#x.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6135
     Transcript showCR:((1->2) performMethod:mthd)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6136
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6137
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6138
    "Modified: 31.7.1997 / 17:41:50 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6139
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6140
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6141
performMethod:aMethod arguments:argumentArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6142
    "invoke aMethod on the receiver, passing an argumentArray.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6143
     The size of the argumentArray should match the number of args
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6144
     expected by the method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6145
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6146
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6147
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6148
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6149
         receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6150
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6151
    ^ aMethod valueWithReceiver:self arguments:argumentArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6152
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6153
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6154
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6155
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6156
     mthd := SmallInteger compiledMethodAt:#+.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6157
     Transcript showCR:(1 performMethod:mthd arguments:#(2))
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6158
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6159
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6160
    "Created: 31.7.1997 / 17:46:31 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6161
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6162
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6163
performMethod:aMethod with:arg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6164
    "invoke aMethod on the receiver, passing an argument.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6165
     The method should be a one-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6166
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6167
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6168
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6169
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6170
         receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6171
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6172
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6173
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6174
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6175
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6176
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6177
     mthd := SmallInteger compiledMethodAt:#+.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6178
     Transcript showCR:(1 performMethod:mthd with:2)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6179
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6180
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6181
    "Modified: 31.7.1997 / 17:42:32 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6182
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6183
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6184
performMethod:aMethod with:arg1 with:arg2
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6185
    "invoke aMethod on the receiver, passing two arguments.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6186
     The method should be a two-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6187
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6188
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6189
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6190
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6191
         receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6192
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6193
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6194
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6195
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6196
     |mthd arr|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6197
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6198
     arr := Array new:1.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6199
     mthd := Array compiledMethodAt:#basicAt:put:.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6200
     arr performMethod:mthd with:1 with:'foo'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6201
     Transcript showCR:arr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6202
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6203
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6204
    "Modified: 31.7.1997 / 17:44:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6205
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6206
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6207
performMethod:aMethod with:arg1 with:arg2 with:arg3
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6208
    "invoke aMethod on the receiver, passing three arguments.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6209
     The method should be a three-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6210
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6211
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6212
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6213
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6214
         receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6215
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6216
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2 with:arg3)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6217
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6218
    "Created: 31.7.1997 / 17:45:20 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6219
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6220
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6221
!Object methodsFor:'printing & storing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6222
6235
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6223
basicPrintOn:aStream
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6224
    "append the receivers className with an articel to the argument, aStream"
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6225
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6226
    aStream nextPutAll:self classNameWithArticle
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6227
!
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6228
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6229
className
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6230
    "return the classname of the receivers class"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6231
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6232
    ^ self class name
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6233
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6234
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6235
     1 className
9105
1666cb465e3f comments
Stefan Vogel <sv@exept.de>
parents: 9071
diff changeset
  6236
     1 class className 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6237
     $a className
9105
1666cb465e3f comments
Stefan Vogel <sv@exept.de>
parents: 9071
diff changeset
  6238
     $a class className
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6239
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6240
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6241
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6242
classNameWithArticle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6243
    "return a string consisting of classname preceeded by an article.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6244
     (dont expect me to write national variants for this ... :-)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6245
     If you have special preferences, redefine it ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6246
6829
db28715efb4d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6815
diff changeset
  6247
    | cls|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6248
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6249
    (cls := self class) == self ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6250
        ^ 'a funny object'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6251
    ].
6829
db28715efb4d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6815
diff changeset
  6252
    ^ cls nameWithArticle
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6253
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6254
    "
6418
0883a068e491 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6405
diff changeset
  6255
     1 classNameWithArticle   
0883a068e491 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6405
diff changeset
  6256
     (1->2) classNameWithArticle    
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6257
     XWorkstation basicNew classNameWithArticle
6418
0883a068e491 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6405
diff changeset
  6258
     XWorkstation classNameWithArticle 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6259
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6260
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6261
    "Modified: 13.5.1996 / 12:16:14 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6262
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6263
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6264
errorPrint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6265
    "print the receiver on the standard error stream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6266
7285
76ff65cdd7e7 Stream streamErrorSignal -> StreamError
Stefan Vogel <sv@exept.de>
parents: 7266
diff changeset
  6267
    StreamError catch:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6268
        self printOn:Stderr
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6269
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6270
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6271
    "Modified: 7.3.1996 / 19:11:29 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6272
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6273
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6274
errorPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6275
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6276
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6277
    "print the receiver followed by a cr on the standard error stream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6278
7285
76ff65cdd7e7 Stream streamErrorSignal -> StreamError
Stefan Vogel <sv@exept.de>
parents: 7266
diff changeset
  6279
    StreamError catch:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6280
        self printOn:Stderr.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6281
        Stderr cr
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6282
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6283
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6284
    "Modified: 7.3.1996 / 19:13:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6285
    "Created: 20.5.1996 / 10:20:41 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6286
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6287
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6288
errorPrintNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6289
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6290
    <resource:#obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6291
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6292
    "print the receiver followed by a cr on the standard error stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6293
     Please use #errorPrintCR - this method exists for backward compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6294
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6295
    ^ self errorPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6296
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6297
    "Modified: 20.5.1996 / 10:24:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6298
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6299
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6300
errorPrintNewline
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6301
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6302
    <resource:#obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6303
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6304
    "print the receiver followed by a cr on the standard error stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6305
     Please use #errorPrintCR - this method exists for backward compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6306
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6307
    self errorPrintCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6308
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6309
    "Modified: 20.5.1996 / 10:24:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6310
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6311
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6312
infoPrint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6313
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6314
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6315
    "print the receiver on the standard error stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6316
     This is meant for information messages which are not warnings
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6317
     or fatal messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6318
     These messages can be turned on/off by 'Object infoPrinting:true/false'"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6319
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6320
    InfoPrinting == true ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6321
        self errorPrint
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6322
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6323
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6324
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6325
infoPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6326
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6327
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6328
    "print the receiver followed by a cr on the standard error stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6329
     This is meant for information messages which are not warnings
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6330
     or fatal messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6331
     These messages can be turned on/off by 'Object infoPrinting:true/false'"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6332
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6333
    InfoPrinting == true ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6334
        self errorPrintCR
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6335
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6336
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6337
    "Created: 20.5.1996 / 10:21:28 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6338
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6339
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6340
infoPrintNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6341
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6342
    <resource:#obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6343
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6344
    "print the receiver followed by a cr on the standard error stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6345
     Please use #infoPrintCR - this method exists for backward compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6346
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6347
    ^ self infoPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6348
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6349
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6350
print
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6351
    "print the receiver on the standard output stream (which is not the Transcript)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6352
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6353
    "/ the following allows printCR to be used during
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6354
    "/ the early init-phase, when no Stdout has been set up.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6355
    "/ (depends on string to respond to #print)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6356
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6357
    Stdout isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6358
        self printString print.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6359
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6360
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6361
    self printOn:Stdout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6362
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6363
    "Modified: 4.11.1996 / 23:36:58 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6364
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6365
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6366
printCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6367
    "print the receiver followed by a cr on the standard output stream (which is not the Transcript)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6368
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6369
    "/ the following allows printCR to be used during
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6370
    "/ the early init-phase, when no Stdout has been set up.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6371
    "/ (depends on string to respond to #printCR)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6372
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6373
    Stdout isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6374
        self printString printCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6375
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6376
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6377
    self printOn:Stdout.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6378
    Stdout cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6379
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6380
    "Created: 20.5.1996 / 10:21:37 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6381
    "Modified: 4.11.1996 / 23:37:06 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6382
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6383
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6384
printNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6385
    "print the receiver followed by a cr on the standard output stream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6386
     This exists for GNU Smalltalk compatibility - please use #printCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6387
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6388
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6389
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6390
    ^ self printCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6391
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6392
    "Modified: 20.5.1996 / 10:25:31 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6393
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6394
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6395
printNewline
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6396
    "print the receiver followed by a cr on the standard output stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6397
     This exists for backward compatibility - please use #printCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6398
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6399
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6400
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6401
    self printCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6402
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6403
    "Modified: 20.5.1996 / 10:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6404
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6405
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6406
printOn:aStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6407
    "append a user printed representation of the receiver to aStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6408
     The format is suitable for a human - not meant to be read back.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6409
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6410
     The default here is to output the receivers class name.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6411
     BUT: this method is heavily redefined for objects which
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6412
     can print prettier."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6413
6235
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6414
    self basicPrintOn:aStream.
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6415
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6416
   "
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6417
    (1@2) printOn:Transcript
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6418
    (1@2) basicPrintOn:Transcript
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6419
   "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6420
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6421
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6422
printOn:aStream leftPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6423
    "print the receiver on aStream, padding with spaces up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6424
     padding is done on the left."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6425
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6426
    self printOn:aStream leftPaddedTo:size with:(Character space)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6427
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6428
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6429
     123 printOn:Transcript leftPaddedTo:10. Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6430
     123 printOn:Transcript leftPaddedTo:2. Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6431
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6432
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6433
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6434
printOn:aStream leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6435
    "print the receiver on aStream, padding with padCharacters up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6436
     padding is done on the left."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6437
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6438
    aStream nextPutAll:(self printStringLeftPaddedTo:size with:padCharacter)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6439
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6440
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6441
     123 printOn:Transcript leftPaddedTo:10 with:$_ . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6442
     123 printOn:Transcript leftPaddedTo:10 with:$. . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6443
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6444
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6445
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6446
printOn:aStream paddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6447
    "print the receiver on aStream, padding with spaces up to size."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6448
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6449
    self printOn:aStream paddedTo:size with:(Character space)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6450
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6451
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6452
     123.0 printOn:Transcript paddedTo:10. Transcript nextPut:$|. Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6453
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6454
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6455
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6456
printOn:aStream paddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6457
    "print the receiver on aStream, padding with padCharacter up to size"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6458
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6459
    aStream nextPutAll:(self printStringPaddedTo:size with:padCharacter).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6460
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6461
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6462
     123 printOn:Transcript paddedTo:10 with:$_ . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6463
     123 printOn:Transcript paddedTo:10 with:$. . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6464
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6465
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6466
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6467
printOn:aStream zeroPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6468
    "print the receiver on aStream, padding with zeros up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6469
     Usually used with float numbers."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6470
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6471
    self printOn:aStream paddedTo:size with:$0.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6472
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6473
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6474
     123.0 printOn:Transcript zeroPaddedTo:10
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6475
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6476
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6477
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6478
printRightAdjustLen:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6479
    "obsolete - just a name confusion.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6480
     This method will go away ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6481
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6482
    (self printStringLeftPaddedTo:size) printOn:Stdout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6483
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6484
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6485
printString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6486
    "return a string for printing the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6487
     Since we now use printOn: as the basic print mechanism,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6488
     we have to create a stream and print into it."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6489
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6490
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6491
8300
d15ead94361f Use CharacterWriteStream in #printString (speedup)
Stefan Vogel <sv@exept.de>
parents: 8287
diff changeset
  6492
    s := CharacterWriteStream on:(String basicNew:30).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6493
    self printOn:s.
8300
d15ead94361f Use CharacterWriteStream in #printString (speedup)
Stefan Vogel <sv@exept.de>
parents: 8287
diff changeset
  6494
    ^ s contents.
7978
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  6495
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  6496
    "
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  6497
     Date today printString.
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  6498
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6499
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6500
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6501
printStringLeftPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6502
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6503
     characters on the left are filled with spaces.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6504
     If the printString is longer than size, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6505
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6506
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6507
    ^ self printStringLeftPaddedTo:size with:(Character space)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6508
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6509
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6510
     10 printStringLeftPaddedTo:10
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6511
     1 printStringLeftPaddedTo:10
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6512
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6513
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6514
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6515
printStringLeftPaddedTo:size ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6516
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6517
     characters on the left are filled with spaces.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6518
     If the printString is larger than size,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6519
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6520
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6521
    ^ self printStringLeftPaddedTo:size with:(Character space) ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6522
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6523
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6524
     12   printStringLeftPaddedTo:3 ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6525
     123  printStringLeftPaddedTo:3 ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6526
     1234 printStringLeftPaddedTo:3 ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6527
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6528
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6529
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6530
printStringLeftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6531
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6532
     characters on the left are filled with padCharacter.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6533
     If the printString is longer than size, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6534
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6535
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6536
    ^ (self printString) leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6537
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6538
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6539
     123 printStringLeftPaddedTo:10 with:$.   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6540
     1 printStringLeftPaddedTo:10 with:$.      
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6541
     (Float pi) printStringLeftPaddedTo:20 with:$*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6542
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6543
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6544
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6545
printStringLeftPaddedTo:size with:padCharacter ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6546
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6547
     characters on the left are filled with padCharacter.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6548
     If the printString is larger than size,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6549
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6550
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6551
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6552
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6553
    s := self printString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6554
    s size > size ifTrue:[^ alternative value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6555
    ^ s leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6556
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6557
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6558
     12   printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6559
     123  printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6560
     1234 printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6561
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6562
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6563
8576
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6564
printStringLimitedTo:sizeLimit
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6565
    "return a string for printing the receiver, but limit the result string in its size."
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6566
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6567
    |s|
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6568
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6569
    s := CharacterWriteStream on:(String basicNew:30).
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6570
    s writeLimit:sizeLimit.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6571
    self printOn:s.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6572
    ^ s contents.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6573
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6574
    "
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6575
     Date today printStringLimitedTo:5.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6576
     '12345678901234567890' printStringLimitedTo:5. 
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6577
    "
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6578
!
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6579
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6580
printStringOnError:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6581
    "return a string for printing the receiver; if any error occurs, return the result from
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6582
     evaluating exceptionBlock. Useful to print something in an exceptionHandler or other
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6583
     cleanup code."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6584
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6585
    |rslt|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6586
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6587
    Error handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6588
        rslt := exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6589
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6590
        rslt := self printString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6591
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6592
    ^ rslt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6593
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6594
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6595
printStringPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6596
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6597
     padded with spaces (at the right) up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6598
     If the printString is longer than size, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6599
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6600
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6601
    ^ self printStringPaddedTo:size with:(Character space)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6602
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6603
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6604
     123 printStringPaddedTo:10    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6605
     1234567890123456 printStringPaddedTo:10  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6606
     'hello' printStringPaddedTo:10   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6607
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6608
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6609
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6610
printStringPaddedTo:size ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6611
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6612
     padded with spaces (at the right) up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6613
     If the resulting printString is too large, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6614
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6615
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6616
    ^ self printStringPaddedTo:size with:(Character space) ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6617
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6618
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6619
     12   printStringPaddedTo:3 ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6620
     123  printStringPaddedTo:3 ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6621
     1234 printStringPaddedTo:3 ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6622
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6623
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6624
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6625
printStringPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6626
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6627
     padded with padCharacter (at the right) up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6628
     If the printString is longer than size, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6629
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6630
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6631
    ^ (self printString) paddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6632
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6633
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6634
     123  printStringPaddedTo:10 with:$.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6635
     123  printStringPaddedTo:10 with:$*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6636
     123  printStringPaddedTo:3 with:$*   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6637
     1234 printStringPaddedTo:3 with:$*   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6638
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6639
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6640
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6641
printStringPaddedTo:size with:padCharacter ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6642
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6643
     padded with padCharacter (at the right) up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6644
     If the resulting printString is too large, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6645
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6646
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6647
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6648
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6649
    s := self printString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6650
    s size > size ifTrue:[^ alternative value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6651
    ^ s paddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6652
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6653
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6654
     123   printStringPaddedTo:3 with:$. ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6655
     12345 printStringPaddedTo:3 with:$. ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6656
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6657
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6658
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6659
printStringRightAdjustLen:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6660
    "obsolete - just a name confusion.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6661
     This method will go away ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6662
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6663
    ^ self printStringLeftPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6664
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6665
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6666
printStringZeroPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6667
    "return a printed representation of the receiver, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6668
     padded with zero (at the right) characters up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6669
     Usually used with float numbers."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6670
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6671
    ^ self printStringPaddedTo:size with:$0
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6672
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6673
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6674
     123.0 printStringZeroPaddedTo:10 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6675
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6676
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6677
8287
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6678
printfPrintString:ignoredFormat
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6679
    "fallback to default printString
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6680
     (for compatibility with float and integer-printing)"
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6681
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6682
    ^ self printString
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6683
!
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6684
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6685
store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6686
    "store the receiver on standard output.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6687
     this method is useless, but included for compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6688
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6689
    self storeOn:Stdout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6690
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6691
7600
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6692
storeArrayElementOn:aStream
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6693
    "store an object as an Array element.
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6694
     Subclasses may redefine this to omit a leading '#'"
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6695
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6696
    ^ self storeOn:aStream
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6697
!
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6698
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6699
storeCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6700
    "store the receiver on standard output; append a carriage return."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6701
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6702
    self store.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6703
    Character cr print
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6704
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6705
    "Created: 20.5.1996 / 10:26:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6706
    "Modified: 20.5.1996 / 10:26:57 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6707
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6708
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6709
storeNl
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6710
    "store the receiver on standard output; append a newline.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6711
     This method is included for backward compatibility-  use #storeCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6712
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6713
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6714
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6715
    self storeCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6716
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6717
    "Modified: 20.5.1996 / 10:26:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6718
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6719
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6720
storeOn:aStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6721
    "store the receiver on aStream; i.e. print an expression which will
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6722
     reconstruct the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6723
     Notice, that no self referencing or cyclic objects can be represented
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6724
     in this format.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6725
     Use storeBinaryOn:, which handles these cases correctly."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6726
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6727
    |myClass hasSemi sz "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6728
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6729
    thisContext isRecursive ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6730
        Object recursiveStoreStringSignal raiseRequestWith:self.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6731
        ('Object [error]: storeString of self referencing object.') errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6732
        aStream nextPutAll:'#("recursive")'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6733
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6734
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6735
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6736
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6737
    aStream nextPut:$(.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6738
    aStream nextPutAll:self class name.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6739
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6740
    hasSemi := false.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6741
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6742
        aStream nextPutAll:' basicNew:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6743
        self basicSize printOn:aStream
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6744
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6745
        aStream nextPutAll:' basicNew'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6746
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6747
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6748
    sz := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6749
    1 to:sz do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6750
        aStream nextPutAll:' instVarAt:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6751
        i printOn:aStream.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6752
        aStream nextPutAll:' put:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6753
        (self instVarAt:i) storeOn:aStream.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6754
        aStream nextPut:$;.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6755
        hasSemi := true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6756
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6757
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6758
        sz := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6759
        1 to:sz do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6760
            aStream nextPutAll:' basicAt:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6761
            i printOn:aStream.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6762
            aStream nextPutAll:' put:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6763
            (self basicAt:i) storeOn:aStream.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6764
            aStream nextPut:$;.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6765
            hasSemi := true
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6766
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6767
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6768
    hasSemi ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6769
        aStream nextPutAll:' yourself'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6770
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6771
    aStream nextPut:$).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6772
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6773
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6774
     |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6775
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6776
     s := WriteStream on:(String new).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6777
     ('hello' -> 'world') storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6778
     s := ReadStream on:(s contents).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6779
     (Object readFrom:s) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6780
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6781
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6782
     |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6783
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6784
     s := 'data' asFilename writeStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6785
     ('hello' -> 'world') storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6786
     s close.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6787
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6788
     s := 'data' asFilename readStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6789
     (Object readFrom:s) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6790
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6791
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6792
    "does not work example:"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6793
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6794
     |s a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6795
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6796
     a := Array new:2.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6797
     a at:1 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6798
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6799
     s := 'data' asFilename writeStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6800
     a storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6801
     s close.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6802
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6803
     s := 'data' asFilename readStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6804
     (Object readFrom:s) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6805
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6806
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6807
    "Modified: 28.1.1997 / 00:36:12 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6808
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6809
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6810
storeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6811
    "return a string representing an expression to reconstruct the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6812
     Notice, that no self referencing or cyclic objects can be represented
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6813
     in this format.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6814
     Use storeBinaryOn:, which handles these cases correctly."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6815
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6816
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6817
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6818
    s := WriteStream on:(String new:50).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6819
    self storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6820
    ^ s contents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6821
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6822
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6823
!Object methodsFor:'queries'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6824
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6825
basicSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6826
    "return the number of the receivers indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6827
     0 if it has none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6828
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6829
     This method should NOT be redefined in any subclass (except with great care, for tuning)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6830
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6831
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6832
8909
485a8e3153e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  6833
    REGISTER INT nbytes;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6834
    REGISTER OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6835
    int nInstBytes;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6836
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6837
    /*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6838
     * notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6839
     * this can be done since basicSize is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6840
     * and SmallInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6841
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6842
    myClass = __qClass(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6843
    nbytes = __qSize(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6844
    nInstBytes = OHDR_SIZE + __OBJS2BYTES__( __intVal(__ClassInstPtr(myClass)->c_ninstvars) );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6845
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6846
    switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6847
        case __MASKSMALLINT(POINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6848
        case __MASKSMALLINT(WKPOINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6849
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  6850
            RETURN ( __mkSmallInteger(__BYTES2OBJS__(nbytes)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6851
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6852
        case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6853
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  6854
            RETURN ( __mkSmallInteger(nbytes / sizeof(char)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6855
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6856
        case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6857
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  6858
            RETURN ( __mkSmallInteger(nbytes / sizeof(float)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6859
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6860
        case __MASKSMALLINT(DOUBLEARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6861
#ifdef __NEED_DOUBLE_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6862
            nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6863
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6864
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  6865
            RETURN ( __mkSmallInteger(nbytes / sizeof(double)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6866
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6867
        case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6868
        case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6869
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  6870
            RETURN ( __mkSmallInteger(nbytes>>1) ); /* notice the hardcoded 2 here - not sizeof(short) */
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6871
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6872
        case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6873
        case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6874
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  6875
            RETURN ( __mkSmallInteger(nbytes>>2) ); /* notice the hardcoded 4 here - not sizeof(int) */
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6876
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6877
        case __MASKSMALLINT(LONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6878
        case __MASKSMALLINT(SLONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6879
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6880
            nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6881
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6882
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  6883
            RETURN ( __mkSmallInteger(nbytes>>3) ); /* notice the hardcoded 8 here - not sizeof(long long) */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6884
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6885
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6886
    ^ 0
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6887
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6888
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6889
byteSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6890
    "return the number of bytes in the receivers indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6891
     0 if it has none. This only returns non-zero for non-pointer indexed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6892
     instvars i.e. byteArrays, wordArrays etc.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6893
     Notice: for Strings the returned size may look strange.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6894
     Only useful with binary storage."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6895
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6896
    |myClass|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6897
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6898
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6899
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6900
        myClass isPointers ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6901
            myClass isBytes ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6902
                ^ self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6903
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6904
            myClass isWords ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6905
                ^ self basicSize * 2.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6906
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6907
            myClass isSignedWords ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6908
                ^ self basicSize * 2.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6909
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6910
            myClass isLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6911
                ^ self basicSize * 4.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6912
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6913
            myClass isSignedLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6914
                ^ self basicSize * 4.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6915
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6916
            myClass isLongLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6917
                ^ self basicSize * 8.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6918
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6919
            myClass isSignedLongLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6920
                ^ self basicSize * 8.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6921
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6922
            myClass isFloats ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6923
                ^ self basicSize * (ExternalBytes sizeofFloat)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6924
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6925
            myClass isDoubles ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6926
                ^ self basicSize * (ExternalBytes sizeofDouble)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6927
            ].
8789
4872313c787a Error handling in #byteSize
Stefan Vogel <sv@exept.de>
parents: 8729
diff changeset
  6928
            self error:'unknown variable size class species'.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6929
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6930
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6931
    ^ 0
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6932
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6933
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6934
     Point new byteSize   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6935
     'hello' byteSize     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6936
     (ByteArray with:1 with:2) byteSize 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6937
     (FloatArray with:1.5) byteSize    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6938
     (DoubleArray with:1.5) byteSize    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6939
     (WordArray with:1 with:2) byteSize    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6940
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6941
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6942
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6943
class
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6944
    "return the receivers class"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6945
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6946
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6947
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6948
    RETURN ( __Class(self) );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6949
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6950
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6951
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6952
respondsTo:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6953
    "return true, if the receiver implements a method with selector equal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6954
     to aSelector; i.e. if there is a method for aSelector in either the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6955
     receivers class or one of its superclasses.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6956
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6957
     Notice, that this does not imply, that such a message can be sent without
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6958
     an error being raised. For example, an implementation could send
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6959
     #shouldNotImplement or #subclassResponsibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6960
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6961
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6962
     should we go via the cache, or search (by class) ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6963
     The first is faster, most of the time; while the 2nd fills
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6964
     the cache with useless data if this is sent in a loop over all objects.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6965
     For now, use the cache ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6966
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6967
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6968
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6969
    if (__lookup(__Class(self), aSelector) == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6970
        RETURN ( false );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6971
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6972
    RETURN ( true );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6973
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6974
.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6975
    ^ self class canUnderstand:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6976
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6977
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6978
    "'aString' respondsTo:#+"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6979
    "'aString' respondsTo:#,"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6980
    "'aString' respondsTo:#collect:"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6981
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6982
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6983
respondsToArithmetic
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6984
    "return true, if the receiver responds to arithmetic messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6985
     false is returned here - the method is redefined in ArithmeticValue."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6986
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6987
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6988
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6989
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6990
size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6991
    "return the number of the receivers indexed instance variables;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6992
     this method may be redefined in subclasses"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6993
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6994
    ^ self basicSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6995
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6996
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6997
species
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6998
    "return a class which is similar to (or the same as) the receivers class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6999
     This is used to create an appropriate object when creating derived
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7000
     copies in the collection classes (sometimes redefined)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7001
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7002
    ^ self class
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7003
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7004
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7005
yourself
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7006
    "return the receiver - used for cascades to return self at the end"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7007
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7008
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7009
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7010
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7011
!Object methodsFor:'secure message sending'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7012
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7013
askFor:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7014
    "try to send the receiver the message, aSelector.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7015
     If it does not understand it, return false. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7016
     Otherwise the real value returned.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7017
     Useful to send messages such as: #isColor to unknown
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7018
     receivers."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7019
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7020
    ^ self perform:aSelector ifNotUnderstood:[false]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7021
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7022
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7023
     1 askFor:#isColor     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7024
     Color red askFor:#isColor 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7025
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7026
     1 askFor:#isFoo     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7027
     Color red askFor:#isFoo 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7028
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7029
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7030
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7031
perform:aSelector ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7032
    "try to send message aSelector to the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7033
     If its understood, return the methods returned value,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7034
     otherwise return the value of the exceptionBlock"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7035
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7036
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7037
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  7038
    MessageNotUnderstood handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7039
        "/ reject, if the bad message is not the one
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7040
        "/ we have sent originally
8502
7720740cf40f Use MessageNotUnderstood>>#selector
Stefan Vogel <sv@exept.de>
parents: 8500
diff changeset
  7041
        ex selector == aSelector ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7042
            ex reject
6741
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7043
        ].
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7044
        ex receiver == self ifFalse:[
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7045
            ex reject
8413
4220f5bb3a39 *** empty log message ***
ca
parents: 8409
diff changeset
  7046
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7047
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7048
        val := self perform:aSelector.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7049
        ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7050
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7051
    ok isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7052
        ^ exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7053
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7054
    ^ val
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7055
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7056
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7057
     1.2345 perform:#foo ifNotUnderstood:['sorry'] 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7058
     1.2345 perform:#sqrt ifNotUnderstood:['sorry'] 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7059
     12345 perform:#sqrt ifNotUnderstood:['sorry']  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7060
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7061
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7062
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7063
perform:aSelector with:argument ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7064
    "try to send message aSelector to the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7065
     If its understood, return the methods returned value,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7066
     otherwise return the value of the exceptionBlock"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7067
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7068
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7069
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7070
    MessageNotUnderstood handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7071
        "/ reject, if the bad message is not the one
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7072
        "/ we have sent originally
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7073
        ex selector == aSelector ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7074
            ex reject
6741
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7075
        ].
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7076
        ex receiver == self ifFalse:[
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7077
            ex reject
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7078
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7079
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7080
        val := self perform:aSelector with:argument.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7081
        ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7082
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7083
    ok isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7084
        ^ exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7085
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7086
    ^ val
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7087
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7088
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7089
     |unknown|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7090
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7091
     unknown := 4.
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7092
     (unknown perform:#- with:2 ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7093
     unknown := 'high there'.
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7094
     (unknown perform:#- with:2 ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7095
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7096
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7097
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7098
perform:aSelector with:arg1 with:arg2 ifNotUnderstood:exceptionBlock
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7099
    "try to send message aSelector to the receiver.
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7100
     If its understood, return the methods returned value,
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7101
     otherwise return the value of the exceptionBlock"
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7102
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7103
    |val ok|
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7104
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7105
    MessageNotUnderstood handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7106
        "/ reject, if the bad message is not the one
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7107
        "/ we have sent originally
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7108
        ex selector == aSelector ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7109
            ex reject
6741
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7110
        ].
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7111
        ex receiver == self ifFalse:[
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7112
            ex reject
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7113
        ]
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7114
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7115
        val := self perform:aSelector with:arg1 with:arg2.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7116
        ok := true.
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7117
    ].
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7118
    ok isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7119
        ^ exceptionBlock value
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7120
    ].
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7121
    ^ val
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7122
!
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7123
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7124
perform:aSelector withArguments:argumentArray ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7125
    "try to send message aSelector to the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7126
     If its understood, return the methods returned value,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7127
     otherwise return the value of the exceptionBlock"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7128
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7129
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7130
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7131
    MessageNotUnderstood handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7132
        "/ reject, if the bad message is not the one
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7133
        "/ we have sent originally
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7134
        ex selector == aSelector ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7135
            ex reject
6741
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7136
        ].
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7137
        ex receiver == self ifFalse:[
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7138
            ex reject
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7139
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7140
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7141
        val := self perform:aSelector withArguments:argumentArray.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7142
        ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7143
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7144
    ok isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7145
        ^ exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7146
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7147
    ^ val
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7148
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7149
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7150
     |unknown|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7151
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7152
     unknown := 4.
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7153
     (unknown perform:#- withArguments:#(2) ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7154
     unknown := 'high there'.
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7155
     (unknown perform:#- withArguments:#(2) ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7156
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7157
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7158
    "Modified: 27.3.1997 / 14:13:16 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7159
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7160
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7161
!Object methodsFor:'signal constants'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7162
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7163
messageNotUnderstoodSignal
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  7164
    ^ MessageNotUnderstood
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7165
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7166
    "Created: 6.3.1997 / 15:46:52 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7167
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7168
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7169
!Object methodsFor:'special queries'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7170
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7171
allOwners
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7172
    "return a collection of all objects referencing the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7173
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7174
    ^ ObjectMemory whoReferences:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7175
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7176
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7177
references:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7178
    "return true, if the receiver refers to the argument, anObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7179
     - for debugging only"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7180
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7181
    ^ self referencesObject:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7182
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7183
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7184
     |v|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7185
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7186
     v := View new initialize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7187
     v references:Display. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7188
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7189
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7190
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7191
referencesAny:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7192
    "return true, if the receiver refers to any object from 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7193
     the argument, aCollection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7194
     - for debugging only"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7195
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7196
%{  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7197
    OBJ cls, flags;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7198
    int nInsts, inst;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7199
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7200
    if (! __isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7201
        RETURN (false);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7202
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7203
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  7204
    if (__isArrayLike(aCollection)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7205
        int nObjs = __arraySize(aCollection);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7206
        char *minAddr = 0, *maxAddr = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7207
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7208
        if (nObjs == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7209
            RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7210
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7211
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7212
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7213
         * a little optimization: use the fact that all old objects
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7214
         * refering to a new object are on the remSet; if I am not,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7215
         * a trivial reject is possible, if all objects are newbees.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7216
         * as a side effect, gather min/max addresses
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7217
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7218
        if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7219
            int allNewBees = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7220
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7221
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7222
            minAddr = (char *)(__ArrayInstPtr(aCollection)->a_element[0]);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7223
            maxAddr = minAddr;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7224
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7225
            for (i=0; i<nObjs; i++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7226
                OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7227
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7228
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7229
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7230
                if (__isNonNilObject(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7231
                    int spc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7232
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7233
                    if (((spc = __qSpace(anObject)) != NEWSPACE) && (spc != SURVSPACE)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7234
                        allNewBees = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7235
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7236
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7237
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7238
                if ((char *)anObject < minAddr) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7239
                    minAddr = (char *)anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7240
                } else if ((char *)anObject > maxAddr) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7241
                    maxAddr = (char *)anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7242
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7243
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7244
            if (allNewBees) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7245
                RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7246
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7247
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7248
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7249
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7250
         * fetch min/max in searchList (if not already done)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7251
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7252
        if (minAddr == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7253
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7254
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7255
            for (i=0; i<nObjs; i++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7256
                OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7257
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7258
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7259
                if ((char *)anObject < minAddr) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7260
                    minAddr = (char *)anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7261
                } else if ((char *)anObject > maxAddr) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7262
                    maxAddr = (char *)anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7263
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7264
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7265
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7266
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7267
        cls = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7268
        if (((char *)cls >= minAddr) && ((char *)cls <= maxAddr)) {
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7269
#if defined(memsrch4)
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7270
            if (memsrch4(__arrayVal(aCollection), (INT)cls, nObjs)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7271
                RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7272
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7273
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7274
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7275
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7276
            for (i=0; i<nObjs; i++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7277
                OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7278
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7279
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7280
                if (cls == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7281
                    RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7282
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7283
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7284
#endif /* memsrch4 */
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7285
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7286
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7287
        flags = __ClassInstPtr(cls)->c_flags;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7288
        if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7289
            nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7290
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7291
            nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7292
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7293
        if (! nInsts) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7294
            RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7295
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7296
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7297
        if (nObjs == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7298
            /* better reverse the loop */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7299
            OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7300
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7301
            anObject = __ArrayInstPtr(aCollection)->a_element[0];
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7302
#if defined(memsrch4)
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7303
            if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7304
                RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7305
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7306
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7307
            for (inst=0; inst<nInsts; inst++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7308
                if ((__InstPtr(self)->i_instvars[inst]) == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7309
                    RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7310
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7311
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7312
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7313
            RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7314
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7315
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7316
        for (inst=0; inst<nInsts; inst++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7317
            OBJ instVar = __InstPtr(self)->i_instvars[inst];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7318
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7319
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7320
            if (((char *)instVar >= minAddr) && ((char *)instVar <= maxAddr)) {
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7321
#if defined(memsrch4)
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7322
                if (memsrch4(__arrayVal(aCollection), (INT)instVar, nObjs)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7323
                    RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7324
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7325
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7326
                for (i=0; i<nObjs; i++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7327
                    OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7328
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7329
                    anObject = __ArrayInstPtr(aCollection)->a_element[i];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7330
                    if (instVar == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7331
                        RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7332
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7333
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7334
#endif /* memsrch4 */
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7335
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7336
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7337
        RETURN (false);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7338
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7339
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7340
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7341
    aCollection do:[:el |
8555
2bff17ee9c22 Use #referencesObject instead of #references:
Stefan Vogel <sv@exept.de>
parents: 8546
diff changeset
  7342
        (self referencesObject:el) ifTrue:[^ true].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7343
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7344
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7345
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7346
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7347
referencesDerivedInstanceOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7348
    "return true, if the receiver refers to an instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7349
     the argument, aClass or its subclass. This method exists
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7350
     to support searching for users of a class."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7351
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7352
    |myClass 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7353
     numInst "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7354
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7355
    "check the class"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7356
    (self isKindOf:aClass) ifTrue:[^ true].
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7357
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7358
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7359
    "check the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7360
    numInst := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7361
    1 to:numInst do:[:i | 
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7362
        ((self instVarAt:i) isKindOf:aClass) ifTrue:[^ true]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7363
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7364
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7365
    "check the indexed variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7366
    myClass isVariable ifTrue:[
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7367
        myClass isPointers ifFalse:[
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7368
            "no need to search in non pointer fields"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7369
            ((aClass == Number) or:[aClass isSubclassOf:Number]) ifFalse:[^ false].
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7370
        ].
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7371
        numInst := self basicSize.
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7372
        1 to:numInst do:[:i | 
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7373
            ((self basicAt:i) isKindOf:aClass) ifTrue:[^ true]
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7374
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7375
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7376
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7377
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7378
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7379
     (1 @ 3.4) referencesDerivedInstanceOf:Number  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7380
     (1 @ 3.4) referencesDerivedInstanceOf:Array   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7381
     View new initialize referencesDerivedInstanceOf:DeviceWorkstation  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7382
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7383
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7384
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7385
referencesForWhich:checkBlock do:actionBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7386
    |myClass inst
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7387
     numInst "{ Class: SmallInteger }" |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7388
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7389
    myClass := self class.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7390
    "check the instance variables"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7391
    numInst := myClass instSize.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7392
    1 to:numInst do:[:i | 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7393
        inst := self instVarAt:i.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7394
        (checkBlock value:inst) ifTrue:[actionBlock value:inst].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7395
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7396
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7397
    "check the indexed variables"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7398
    myClass isVariable ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7399
        myClass isPointers ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7400
            "no need to search in non pointer fields"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7401
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7402
            numInst := self basicSize.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7403
            1 to:numInst do:[:i | 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7404
                inst := self basicAt:i.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7405
                (checkBlock value:inst) ifTrue:[actionBlock value:inst].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7406
            ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7407
        ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7408
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7409
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7410
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7411
     (1 @ 3.4) referencesForWhich:[:i | i isFloat] do:[:i | Transcript showCR:i]  
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7412
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7413
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7414
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7415
referencesInstanceOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7416
    "return true, if the receiver refers to an instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7417
     the argument, aClass.This method exists
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7418
     to support searching for users of a class."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7419
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7420
    |myClass 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7421
     numInst "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7422
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7423
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7424
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7425
    "check the class"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7426
    (myClass isMemberOf:aClass) ifTrue:[^ true].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7427
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7428
    "check the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7429
    numInst := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7430
    1 to:numInst do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7431
        ((self instVarAt:i) isMemberOf:aClass) ifTrue:[^ true]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7432
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7433
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7434
    "check the indexed variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7435
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7436
        myClass isPointers ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7437
            "no need to search in non-pointer indexed fields"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7438
            myClass isLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7439
                (aClass == SmallInteger or:[aClass == LargeInteger]) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7440
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7441
                myClass isFloatsOrDoubles ifTrue:[^ aClass == Float].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7442
                ^ aClass == SmallInteger
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7443
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7444
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7445
        numInst := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7446
        1 to:numInst do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7447
            ((self basicAt:i) isMemberOf:aClass) ifTrue:[^ true]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7448
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7449
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7450
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7451
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7452
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7453
     (1 @ 3.4) referencesInstanceOf:Float     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7454
     (1 @ 3.4) referencesInstanceOf:Fraction    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7455
     View new initialize referencesInstanceOf:(Display class)  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7456
    "
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7457
!
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7458
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7459
referencesObject:anObject
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7460
    "return true, if the receiver refers to the argument, anObject.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7461
     - for debugging only"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7462
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7463
%{  /* NOCONTEXT */
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7464
    OBJ cls, flags;
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7465
    int nInsts, i;
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7466
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7467
    if (! __isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7468
        RETURN (false);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7469
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7470
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7471
    /*
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7472
     * a little optimization: use the fact that all old objects
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7473
     * refering to a new object are on the remSet; if I am not,
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7474
     * a trivial reject is possible, if anObject is a newbee
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7475
     */
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7476
    if (__isNonNilObject(anObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7477
        if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7478
            int spc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7479
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7480
            if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7481
                RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7482
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7483
        }
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7484
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7485
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7486
    cls = __qClass(self);
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7487
    if (cls == anObject) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7488
        RETURN (true);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7489
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7490
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7491
    flags = __ClassInstPtr(cls)->c_flags;
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7492
    if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7493
        nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7494
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7495
        nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7496
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7497
    if (! nInsts) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7498
        RETURN (false);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7499
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7500
#if defined(memsrch4)
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7501
    if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7502
        RETURN (true);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7503
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7504
#else
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7505
    for (i=0; i<nInsts; i++) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7506
        if (__InstPtr(self)->i_instvars[i] == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7507
            RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7508
        }
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7509
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7510
#endif /* memsrch4 */
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7511
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7512
%}.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7513
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7514
"/    |myClass 
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7515
"/     numInst "{ Class: SmallInteger }" |
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7516
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7517
"/    myClass := self class.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7518
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7519
"/    "check the class"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7520
"/    (myClass == anObject) ifTrue:[^ true].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7521
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7522
"/    "check the instance variables"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7523
"/    numInst := myClass instSize.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7524
"/    1 to:numInst do:[:i | 
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7525
"/      ((self instVarAt:i) == anObject) ifTrue:[^ true]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7526
"/    ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7527
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7528
"/    "check the indexed variables"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7529
"/    myClass isVariable ifTrue:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7530
"/      myClass isPointers ifFalse:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7531
"/          "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7532
"/          "/ we could argue about the following unconditional return:
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7533
"/          "/ it says that a non pointer array never has a reference to the
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7534
"/          "/ corresponding object - not mimicing a reference to a copy of the
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7535
"/          "/ integer. However, it avoids useless searches in huge byteArray
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7536
"/          "/ like objects when searching for owners. If in doubt, remove it.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7537
"/          "/ A consequence of the return below is that #[1 2 3] will say that it
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7538
"/          "/ does not refer to the number 2 (think of keeping a copy instead)
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7539
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7540
"/          ^ false.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7541
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7542
"/          "/ alternative:
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7543
"/          "/  anObject isNumber ifFalse:[^ false].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7544
"/      ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7545
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7546
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7547
"/      "/ because arrays are so common, and those have a highly tuned
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7548
"/      "/ idenitytIndex method, use it
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7549
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7550
"/      myClass == Array ifTrue:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7551
"/          ^ (self identityIndexOf:anObject) ~~ 0
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7552
"/      ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7553
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7554
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7555
"/      "/ otherwise, do it the slow way
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7556
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7557
"/      numInst := self basicSize.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7558
"/      1 to:numInst do:[:i | 
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7559
"/          ((self basicAt:i) == anObject) ifTrue:[^ true]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7560
"/      ]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7561
"/    ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7562
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7563
    ^ false
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7564
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7565
    "
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7566
     |v|
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7567
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7568
     v := View new initialize.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7569
     v references:Display. 
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7570
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7571
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7572
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7573
!Object methodsFor:'synchronized evaluation'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7574
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7575
freeSynchronizationSemaphore    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7576
    "free synchronizationSemaphore. May be used, to save memory when
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7577
     an object is no longer used synchronized."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7578
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7579
    |sema|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7580
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7581
    sema := self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7582
    sema notNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7583
        sema wait.              "/ get lock
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7584
        self synchronizationSemaphore:nil.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7585
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7586
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7587
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7588
     self synchronized:[].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7589
     self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7590
     self freeSynchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7591
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7592
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7593
    "Created: 28.1.1997 / 19:31:20 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7594
    "Modified: 28.1.1997 / 19:47:55 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7595
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7596
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7597
synchronizationSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7598
    "return the synchronization semaphore for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7599
     subclasses may redefine"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7600
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7601
    ^ SynchronizationSemaphores at:self ifAbsent:[].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7602
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7603
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7604
      self synchronizationSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7605
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7606
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7607
    "Modified: 28.1.1997 / 19:47:09 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7608
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7609
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7610
synchronizationSemaphore:aSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7611
    "set the synchronisationSemaphore for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7612
     subclasses may redefine this method"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7613
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7614
    aSemaphore isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7615
        "/ remove Semaphore
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7616
        SynchronizationSemaphores removeKey:self ifAbsent:nil.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7617
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7618
        SynchronizationSemaphores at:self put:aSemaphore.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7619
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7620
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7621
    "Modified: 28.1.1997 / 19:37:48 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7622
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7623
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7624
synchronized:aBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7625
    "evaluate aBlock synchronized, i.e. use a monitor for this object"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7626
6600
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7627
    |sema wasBlocked|
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7628
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7629
    wasBlocked := OperatingSystem blockInterrupts.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7630
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7631
    sema := self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7632
    sema isNil ifTrue:[
8481
d12d202b6ddb Set name of synchronization sema
Stefan Vogel <sv@exept.de>
parents: 8441
diff changeset
  7633
        sema := RecursionLock new name:self className.
6600
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7634
        self synchronizationSemaphore:sema.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7635
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7636
6600
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7637
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
7211
87f5d25b5c3d Make synchronizationSemaphore a recursionLock
Stefan Vogel <sv@exept.de>
parents: 7208
diff changeset
  7638
    sema critical:aBlock.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7639
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7640
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7641
       [Object synchronized:[Delay waitForSeconds:2. Transcript showCR:'1']] fork.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7642
       [Object synchronized:[Delay waitForSeconds:2. Transcript showCR:'2']] fork.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7643
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7644
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7645
    "Created: 28.1.1997 / 17:52:56 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7646
    "Modified: 30.1.1997 / 13:38:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7647
    "Modified: 20.2.1997 / 09:43:35 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7648
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7649
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7650
!Object methodsFor:'system primitives'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7651
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7652
asOop
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7653
    "ST-80 compatibility:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7654
     ST-80 returns an OOP-identity based number here (I guess: its address
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7655
     or index); since ST/X has no such thing, and the objects address cannot
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7656
     be used (since its changing over time), we return the objects identityHash 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7657
     key, which provides (at least) some identity indication.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7658
     However, notice that (in contrast to ST-80's #asOop), the identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7659
     key of two non-identical objects may be the same.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7660
     You'd better not use it - especially do not misuse it."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7661
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7662
    ^ self identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7663
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7664
    "Created: 9.11.1996 / 19:09:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7665
    "Modified: 9.11.1996 / 19:16:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7666
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7667
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7668
beImmutable
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7669
    "experimental - not yet usable; do not use"
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7670
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7671
%{  /* NOCONTEXT */
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7672
    if (! __isNonNilObject(self)) {
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7673
        RETURN (self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7674
    }
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7675
    __beImmutable(self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7676
%}
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7677
!
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7678
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7679
beMutable
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7680
    "experimental - not yet usable; do not use"
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7681
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7682
%{  /* NOCONTEXT */
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7683
    if (! __isNonNilObject(self)) {
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7684
        RETURN (self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7685
    }
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7686
    __beMutable(self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7687
%}
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7688
!
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7689
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7690
become:anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7691
    "make all references to the receiver become references to anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7692
     and vice-versa. Notice the vice-versa; see #becomeSameAs: for a one-way become.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7693
     This can be a very dangerous operation - be warned.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7694
     In general, using #become: should be avoided if possible, since it may 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7695
     produce many strange effects (think of hashing in Sets, Dictionaries etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7696
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7697
     This may also be an expensive (i.e. slow) operation, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7698
     since in the worst case, the whole memory has to be searched for 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7699
     references to the two objects (although the primitive tries hard to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7700
     limit the search, for acceptable performance in most cases). 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7701
     This method fails, if the receiver or the argument is a SmallInteger 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7702
     or nil, or is a context of a living method (i.e. one that has not already 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7703
     returned).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7704
     (notice that #become: is not used heavily by the system 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7705
      - the Collection-classes have been rewritten to not use it.)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7706
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7707
    if (__primBecome(self, anotherObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7708
        RETURN ( self );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7709
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7710
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7711
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7712
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7713
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7714
becomeNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7715
    "make all references to the receiver become nil - effectively getting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7716
     rid of the receiver. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7717
     This can be a very dangerous operation - be warned.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7718
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7719
     This may be an expensive (i.e. slow) operation.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7720
     The receiver may not be a SmallInteger or a context of a living method."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7721
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7722
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7723
    if (__primBecomeNil(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7724
        RETURN ( nil );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7725
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7726
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7727
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7728
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7729
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7730
becomeSameAs:anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7731
    "make all references to the receiver become references to anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7732
     but NOT vice versa (as done in #become:).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7733
     This can be a very dangerous operation - be warned.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7734
     In general, using #become: should be avoided if possible, since it may 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7735
     produce many strange effects (think of hashing in Sets, Dictionaries etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7736
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7737
     This may also be an expensive (i.e. slow) operation,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7738
     since in the worst case, the whole memory has to be searched for
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7739
     references to the two objects (although the primitive tries hard to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7740
     limit the search, for acceptable performance in most cases).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7741
     This method fails, if the receiver or the argument is a SmallInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7742
     or nil, or is a context of a living method (i.e. one that has not already returned)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7743
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7744
    if (__primBecomeSameAs(self, anotherObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7745
        RETURN ( self );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7746
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7747
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7748
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7749
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7750
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7751
changeClassTo:otherClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7752
    "changes the class of the receiver to the argument, otherClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7753
     This is only allowed (possible), if the receivers class and the argument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7754
     have the same structure (i.e. number of named instance variables and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7755
     type of indexed instance variables). 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7756
     If the structures do not match, or any of the original class or new class
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7757
     is UndefinedObject or a Smallinteger, a primitive error is triggered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7758
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7759
    |myClass ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7760
9405
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  7761
    otherClass autoload.
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  7762
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7763
    "check for UndefinedObject/SmallInteger receiver or newClass"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7764
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7765
    {
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7766
        OBJ other = otherClass;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7767
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7768
        if (__isNonNilObject(self) 
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7769
         && __isNonNilObject(other)
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7770
         && (other != UndefinedObject)
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7771
         && (other != SmallInteger)) {
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7772
            ok = true;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7773
        } else {
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7774
            ok = false;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7775
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7776
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7777
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7778
    ok ifTrue:[
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7779
        ok := false.
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7780
        myClass := self class.
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7781
        myClass flags == otherClass flags ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7782
            myClass instSize == otherClass instSize ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7783
                "same instance layout and types: its ok to do it"
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7784
                ok := true.
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7785
            ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7786
                myClass isPointers ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7787
                    myClass isVariable ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7788
                        ok := true
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7789
                    ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7790
                ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7791
            ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7792
        ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7793
            myClass isPointers ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7794
                "if newClass is a variable class, with instSize <= my instsize,
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7795
                 we can do it (effectively mapping additional instvars into the
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7796
                 variable part) - usefulness is questionable, though"
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7797
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7798
                otherClass isPointers ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7799
                    otherClass isVariable ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7800
                        otherClass instSize <= (myClass instSize + self basicSize) 
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7801
                        ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7802
                            ok := true
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7803
                        ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7804
                    ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7805
                        otherClass instSize == (myClass instSize + self basicSize) 
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7806
                        ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7807
                            ok := true
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7808
                        ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7809
                    ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7810
                ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7811
                    "it does not make sense to convert pointers to bytes ..."
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7812
                ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7813
            ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7814
                "does it make sense, to convert bits ?"
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7815
                "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7816
                (myClass isBitsExtended and:[otherClass isBitsExtended]) ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7817
                    ok := true
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7818
                ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7819
            ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7820
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7821
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7822
    ok ifTrue:[
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7823
        "now, change the receivers class ..."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7824
%{
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7825
        {
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7826
            OBJ me = self;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7827
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7828
            __qClass(me) = otherClass;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7829
            __STORE(me, otherClass);
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7830
            RETURN (me);
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  7831
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7832
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7833
    ].
9405
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  7834
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7835
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7836
     the receiver cannot be represented as a instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7837
     the desired class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7838
     For example, you cannot change a bitInstance (byteArray etc.) 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7839
     into a pointer object and vice versa.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7840
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7841
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7842
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7843
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7844
changeClassToThatOf:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7845
    "changes the class of the receiver to that of the argument, anObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7846
     This is only allowed (possible), if the receivers class and the arguments
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7847
     class have the same structure (i.e. number of named instance variables and 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7848
     type of indexed instance variables). If the structures do not match, or any
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7849
     of the objects is nil or a Smallinteger, a primitive error is triggered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7850
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7851
    self changeClassTo:(anObject class)
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7852
!
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7853
8935
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7854
isImmutable
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7855
    "experimental - not yet usable; do not use"
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7856
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7857
%{  /* NOCONTEXT */
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7858
    if (! __isNonNilObject(self)) {
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7859
        RETURN (true);
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7860
    }
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7861
    RETURN (__isImmutable(self) ? true : false);
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7862
%}
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7863
!
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  7864
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7865
replaceReferencesTo:anObject with:newRef
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7866
    "if the receiver refers to the argument, anObject, replace this reference with newRef.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7867
     Return true, if any reference was changed.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7868
     Notice: this does not change the class-reference."
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7869
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7870
%{  /* NOCONTEXT */
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7871
    OBJ cls, flags, anyChange;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7872
    int nInsts, i;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7873
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7874
    if (! __isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7875
        RETURN (false);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7876
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7877
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7878
    /*
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7879
     * a little optimization: use the fact that all old objects
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7880
     * refering to a new object are on the remSet; if I am not,
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7881
     * a trivial reject is possible, if anObject is a newbee
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7882
     */
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7883
    if (__isNonNilObject(anObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7884
        if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7885
            int spc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7886
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7887
            if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7888
                RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7889
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7890
        }
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7891
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7892
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7893
    cls = __qClass(self);
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7894
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7895
    flags = __ClassInstPtr(cls)->c_flags;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7896
    if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7897
        nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7898
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7899
        nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7900
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7901
    if (! nInsts) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7902
        RETURN (false);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7903
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7904
    anyChange = false;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7905
    for (i=0; i<nInsts; i++) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7906
        if (__InstPtr(self)->i_instvars[i] == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7907
            __InstPtr(self)->i_instvars[i] = newRef;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7908
            __STORE(self, newRef);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7909
            anyChange = true;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7910
        }
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7911
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7912
    RETURN (anyChange);
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7913
%}.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7914
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7915
    "
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7916
     |v|
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7917
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7918
     v := Array with:1234 with:'hello' with:Array.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7919
     v replaceReferencesTo:Array with:ByteArray.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7920
     v inspect
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  7921
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7922
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7923
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7924
!Object methodsFor:'testing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7925
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7926
? defaultValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7927
     "a syntactic shugar-piece:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7928
      if the receiver is nil, return the defaultValue;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7929
      otherwise, return the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7930
      This method is only redefined in UndefinedObject - therefore,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7931
      the recevier is retuned here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7932
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7933
      Thus, if foo and bar are simple variables or constants,
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7934
          foo ? bar
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7935
      is the same as:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7936
          (foo isNil ifTrue:[bar] ifFalse:[foo])
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7937
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7938
      if they are message sends, the equivalent code is:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7939
          [
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7940
              |t1 t2|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7941
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7942
              t1 := foo.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7943
              t2 := bar.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7944
              t1 isNil ifTrue:[t2] ifFalse:[t1]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7945
          ] value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7946
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7947
      Can be used to provide defaultValues to variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7948
      as in:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7949
          foo := arg ? #defaultValue
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7950
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7951
      Note: this method should never be redefined in classes other than UndefinedObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7952
      Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7953
         This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7954
         - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7955
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7956
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7957
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7958
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7959
     1 ? #default
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7960
     nil ? #default
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7961
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7962
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7963
    "Created: / 4.11.1996 / 20:36:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7964
    "Modified: / 19.5.1998 / 17:39:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7965
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7966
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7967
?? defaultValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7968
     "a syntactic shugar-piece:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7969
      much like ?, but sends #value to the argument if required.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7970
      (i.e. its the same as #ifNil:)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7971
      If the receiver is nil, return the defaultValues value;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7972
      otherwise, return the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7973
      This method is only redefined in UndefinedObject - therefore,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7974
      the recevier is retuned here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7975
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7976
      Thus, if foo and bar are simple variables or constants,
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7977
          foo ?? bar
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7978
      is the same as:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7979
          (foo isNil ifTrue:[bar value] ifFalse:[foo])
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7980
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7981
      if they are message sends, the equivalent code is:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7982
          [
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7983
              |t t2|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7984
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7985
              t := foo.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7986
              t isNil ifTrue:[bar value] ifFalse:[t]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7987
          ] value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7988
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7989
      Can be used to provide defaultValues to variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7990
      as in:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7991
          foo := arg ?? [ self computeDefault ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7992
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7993
      Note: this method should never be redefined in classes other than UndefinedObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7994
     "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7995
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7996
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7997
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7998
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7999
     1 ?? #default 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8000
     nil ?? #default
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8001
     1 ?? [ self halt. 1 + 2 ] 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8002
     nil ?? [ self halt. 1 + 2 ] 
6069
9aff12a37f5e comment
Claus Gittinger <cg@exept.de>
parents: 6068
diff changeset
  8003
     1 ?? [Date today]   
9aff12a37f5e comment
Claus Gittinger <cg@exept.de>
parents: 6068
diff changeset
  8004
     nil ?? [Date today]  
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8005
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8006
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8007
    "Created: / 4.11.1996 / 20:36:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8008
    "Modified: / 19.5.1998 / 17:42:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8009
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8010
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8011
ifNil:aBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8012
    "return myself, or the result from evaluating the argument, if I am nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8013
     This is much like #?, but sends #value to the argument in case of a nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8014
     receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8015
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8016
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8017
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8018
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8019
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8020
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8021
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8022
ifNil:nilBlockOrValue ifNotNil:notNilBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8023
    "return the value of the first arg, if I am nil,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8024
     the result from evaluating the 2nd argument, if I am not nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8025
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8026
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8027
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8028
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8029
    ^ notNilBlockOrValue value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8030
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8031
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8032
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8033
ifNotNil:aBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8034
    "return myself if nil, or the result from evaluating the argument, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8035
     if I am not nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8036
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8037
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8038
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8039
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8040
    ^ aBlockOrValue value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8041
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8042
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8043
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8044
ifNotNil:notNilBlockOrValue ifNil:nilBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8045
    "return the value of the 2nd arg, if I am nil,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8046
     the result from evaluating the 1st argument, if I am not nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8047
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8048
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8049
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8050
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8051
    ^ notNilBlockOrValue value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8052
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8053
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8054
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8055
8574
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8056
ifNotNilDo:aBlock
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8057
    "if the reciever is non-nil, return the value of aBlock, passing myself as argument.
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8058
     Otherwise do nothing and return nil."
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8059
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8060
    ^ aBlock value:self
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8061
!
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8062
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8063
isArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8064
    "return true, if the receiver is some kind of array (or weakArray etc);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8065
     false is returned here - the method is only redefined in Array."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8066
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8067
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8068
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8069
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8070
isAssociation
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8071
    "return true, if the receiver is some kind of association;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8072
     false is returned here - the method is only redefined in Association."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8073
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8074
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8075
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8076
    "Created: 14.5.1996 / 17:03:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8077
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8078
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8079
isBehavior
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8080
    "return true, if the receiver is describing another objects behavior.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8081
     False is returned here - the method is only redefined in Behavior."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8082
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8083
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8084
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8085
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8086
isBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8087
    "return true, if the receiver is some kind of block;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8088
     false returned here - the method is only redefined in Block."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8089
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8090
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8091
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8092
5824
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8093
isBoolean
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8094
    "return true, if the receiver is a boolean;
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8095
     false is returned here - the method is only redefined in Boolean."
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8096
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8097
    ^ false
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8098
!
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8099
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8100
isByteArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8101
    "return true, if the receiver is some kind of bytearray;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8102
     false is returned here - the method is only redefined in ByteArray."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8103
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8104
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8105
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8106
8986
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8107
isByteCollection
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8108
    "return true, if the receiver is some kind of byte collection,
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8109
     i.e. #at: and #at:put: accesses a byte. This is different from 'self class isBytes', 
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8110
     since e.g. in BitArray single bits are accessed, but it is implemented as variableBytes class.
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8111
    
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8112
     false is returned here - the method is only redefined in UninterpretedBytes."
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8113
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8114
    ^ false
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8115
!
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8116
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8117
isCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8118
    "return true, if the receiver is some kind of character;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8119
     false is returned here - the method is only redefined in Character."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8120
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8121
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8122
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8123
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8124
isClass
9405
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  8125
    "return true, if the receiver is some kind of class
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  8126
     (real class, not just behavior);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8127
     false is returned here - the method is only redefined in Class."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8128
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8129
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8130
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8131
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8132
isCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8133
    "return true, if the receiver is some kind of collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8134
     false is returned here - the method is only redefined in Collection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8135
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8136
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8137
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8138
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8139
isColor
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8140
    "return true, if the receiver is some kind of color;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8141
     false is returned here - the method is only redefined in Color."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8142
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8143
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8144
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8145
6567
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8146
isCons
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8147
    "return true, if the receiver is a cons (pair);
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8148
     false is returned here - the method is only redefined in Cons."
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8149
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8150
    ^ false
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8151
!
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8152
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8153
isContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8154
    "return true, if the receiver is some kind of context;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8155
     false returned here - the method is only redefined in Context."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8156
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8157
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8158
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8159
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8160
isEmptyOrNil
8833
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8161
    "return true if I am nil or an empty collection - return false here.
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8162
     (from Squeak)"
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8163
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8164
    ^ false
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8165
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8166
    "Created: / 13.11.2001 / 13:17:04 / cg"
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  8167
    "Modified: / 13.11.2001 / 13:28:40 / cg"
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8168
!
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8169
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8170
isException
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8171
    "answer true, if this ia an Exception, that may be queried about its type"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8172
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8173
    ^ false
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8174
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8175
    "Created: / 17.11.2001 / 18:37:44 / cg"
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8176
!
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8177
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8178
isExceptionCreator
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8179
    "return true, if the receiver can create exceptions,
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8180
     this includes #raise, #raiseRequest as well as the behavior of
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8181
     an exception handler, such as the #accepts: and #handles: messages"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8182
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8183
    ^ false
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8184
!
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8185
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8186
isExceptionHandler
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8187
    "return true, if the receiver responds to the exception handler protocol,
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8188
     especially to the #accepts: and #handles: messages"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8189
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8190
    ^ false
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8191
!
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8192
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8193
isExternalStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8194
    "return true, if the receiver is some kind of externalStream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8195
     false is returned here - the method is only redefined in ExternalStream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8196
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8197
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8198
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8199
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8200
isFileStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8201
    "return true, if the receiver is some kind of fileStream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8202
     false is returned here - the method is only redefined in FileStream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8203
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8204
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8205
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8206
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8207
isFilename
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8208
    "return true, if the receiver is some kind of filename;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8209
     false is returned here - the method is only redefined in Filename."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8210
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8211
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8212
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8213
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8214
isFixedPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8215
    "return true, if the receiver is some kind of fixedPoint number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8216
     false is returned here - the method is only redefined in FixedPoint."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8217
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8218
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8219
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8220
    "Created: 5.11.1996 / 19:23:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8221
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8222
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8223
isFixedSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8224
    "return true if the receiver cannot grow easily 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8225
     (i.e. a grow may be expensive, since it involves a become:)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8226
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8227
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8228
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8229
6185
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8230
isFloat
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8231
    "return true, if the receiver is some kind of floating point number;
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8232
     false is returned here.
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8233
     Same as #isLimitedPrecisionReal, but a better name ;-)"
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8234
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8235
    ^ false
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8236
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8237
    "Modified: / 14.11.2001 / 14:57:46 / cg"
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8238
!
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8239
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8240
isForm
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8241
    "return true, if the receiver is some kind of form;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8242
     false is returned here - the method is only redefined in Form."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8243
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8244
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8245
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8246
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8247
isFraction
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8248
    "return true, if the receiver is some kind of fraction;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8249
     false is returned here - the method is only redefined in Fraction."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8250
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8251
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8252
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8253
9293
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8254
isHierarchicalItem
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8255
    "used to decide if the parent is a hierarchical item or the model"
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8256
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8257
    ^ false
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8258
!
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8259
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8260
isImage
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8261
    "return true, if the receiver is some kind of image;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8262
     false is returned here - the method is only redefined in Image."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8263
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8264
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8265
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8266
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8267
isImageOrForm
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8268
    "return true, if the receiver is some kind of image or form;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8269
     false is returned here - the method is only redefined in Image and Form."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8270
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8271
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8272
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8273
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8274
isImmediate
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8275
    "return true if I am an immediate object
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8276
     i.e. I am represented in the pointer itself and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8277
     no real object header/storage is used me.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8278
     (currently, only SmallIntegers, some characters and nil return true)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8279
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8280
    ^ self class hasImmediateInstances
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8281
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8282
    "Created: 3.6.1997 / 12:00:18 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8283
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8284
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8285
isInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8286
    "return true, if the receiver is some kind of integer number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8287
     false is returned here - the method is only redefined in Integer."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8288
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8289
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8290
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8291
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8292
isInterestConverter
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8293
    "return true if I am a kind of interest forwarder"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8294
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8295
    ^ false
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8296
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8297
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8298
isJavaClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8299
    "return true, if this is a javaClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8300
     false is returned here - the method is only redefined in JavaClass."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8301
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8302
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8303
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8304
    "Created: / 26.3.1997 / 13:34:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8305
    "Modified: / 8.5.1998 / 21:25:21 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8306
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8307
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8308
isJavaClassRef
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8309
    "return true, if this is a JavaClassRef.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8310
     false is returned here - the method is only redefined in JavaClassRef."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8311
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8312
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8313
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8314
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8315
    "Created: / 24.12.1999 / 01:46:28 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8316
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8317
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8318
isJavaContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8319
    "return true, if this is a javaContext.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8320
     false is returned here - the method is only redefined in JavaContext."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8321
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8322
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8323
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8324
    "Created: / 8.5.1998 / 21:24:27 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8325
    "Modified: / 8.5.1998 / 21:25:35 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8326
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8327
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8328
isJavaMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8329
    "return true, if this is a JavaMethod.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8330
     false is returned here - the method is only redefined in JavaMethod."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8331
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8332
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8333
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8334
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8335
    "Created: / 25.9.1999 / 23:26:12 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8336
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8337
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8338
isJavaMethodRef
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8339
    "return true, if this is a JavaMethodRef.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8340
     false is returned here - the method is only redefined in JavaMethodRef."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8341
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8342
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8343
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8344
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8345
    "Created: / 23.12.1999 / 19:44:51 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8346
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8347
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8348
isJavaObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8349
    "return true, if this is a javaObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8350
     false is returned here - the method is only redefined in JavaObject."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8351
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8352
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8353
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8354
    "Created: / 26.3.1997 / 13:34:48 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8355
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8356
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8357
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8358
isJavaScriptClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8359
    "return true, if this is a javaScriptClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8360
     false is returned here - the method is only redefined in JavaScriptClass."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8361
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8362
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8363
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8364
8935
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8365
isJavaScriptMetaclass
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8366
    "return true, if this is a javaScript Metaclass.
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8367
     false is returned here - the method is only redefined in JavaScriptMetaclass."
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8368
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8369
    ^ false
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8370
!
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8371
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8372
isKindOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8373
    "return true, if the receiver is an instance of aClass or one of its
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8374
     subclasses, false otherwise.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8375
     Advice: 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8376
        use of this to check objects for certain attributes/protocoll should
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8377
        be avoided; it limits the reusability of your classes by limiting use
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8378
        to instances of certain classes and fences you into a specific inheritance 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8379
        hierarchy.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8380
        Use check-methods to check an object for a certain attributes/protocol
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8381
        (such as #isXXXX, #respondsTo: or #isNumber).
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8382
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8383
        Using #isKindOf: is considered BAD STYLE.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8384
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8385
     Advice2:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8386
        Be aware, that using an #isXXX method is usually much faster than 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8387
        using #isKindOf:; because isKindOf: has to walk up all the superclass 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8388
        hierarchy, comparing every class on the way. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8389
        Due to caching in the VM, a call to #isXXX is normally reached via
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8390
        a single function call.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8391
     "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8392
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8393
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8394
    register OBJ thisClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8395
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8396
    thisClass = __Class(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8397
    while (thisClass != nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8398
        if (thisClass == aClass) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8399
            RETURN ( true );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8400
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8401
        thisClass = __ClassInstPtr(thisClass)->c_superclass;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8402
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8403
    RETURN ( false );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8404
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8405
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8406
"/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8407
"/  the above code is equivalent to:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8408
"/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8409
"/  thisClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8410
"/  [thisClass notNil] whileTrue:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8411
"/      thisClass == aClass ifTrue:[^ true].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8412
"/      thisClass := thisClass superclass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8413
"/  ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8414
"/  ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8415
"/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8416
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8417
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8418
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8419
isLayout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8420
    "return true, if the receiver is some kind of layout;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8421
     false is returned here - the method is only redefined in Layout."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8422
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8423
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8424
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8425
6567
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8426
isLazyValue
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8427
    ^ false
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8428
!
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8429
6086
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8430
isLimitedPrecisionReal
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8431
    "return true, if the receiver is some kind of floating point number;
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8432
     false is returned here - the method is only redefined in LimitedPrecisionReal."
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8433
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8434
    ^ false
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8435
!
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8436
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8437
isList
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8438
    "return true, if the receiver is some kind of list collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8439
     false is returned here - the method is only redefined in List."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8440
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8441
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8442
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8443
    "Created: / 11.2.2000 / 01:37:05 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8444
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8445
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8446
isLiteral
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8447
    "return true, if the receiver can be represented as a literal constant in ST syntax;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8448
     false is returned here - the method is redefined in some classes."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8449
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8450
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8451
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8452
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8453
isMemberOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8454
    "return true, if the receiver is an instance of aClass, false otherwise.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8455
     Advice: 
8833
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8456
        use of this to check objects for certain attributes/protocol should
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8457
        be avoided; it limits the reusability of your classes by limiting use
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8458
        to instances of a certain class.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8459
        Use check-methods to check an object for a certain attributes/protocol
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8460
        (such as #isXXX, #respondsTo: or #isNumber);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8461
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8462
        Using #isMemberOf: is considered BAD STYLE.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8463
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8464
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8465
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8466
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8467
    ^ (self class) == aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8468
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8469
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8470
isMeta
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8471
    "return true, if the receiver is some kind of metaclass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8472
     false is returned here - the method is only redefined in Metaclass."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8473
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8474
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8475
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8476
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8477
isMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8478
    "return true, if the receiver is some kind of method;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8479
     false returned here - the method is only redefined in Method."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8480
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8481
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8482
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8483
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8484
isMorph
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8485
    "return true, if the receiver is some kind of morph;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8486
     false is returned here - the method is only redefined in Morph."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8487
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8488
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8489
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8490
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8491
isNameSpace
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8492
    "return true, if the receiver is a nameSpace.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8493
     False is returned here - the method is only redefined in Namespace."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8494
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8495
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8496
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8497
    "Created: / 11.10.1996 / 18:08:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8498
    "Modified: / 8.5.1998 / 21:26:05 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8499
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8500
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8501
isNamespace
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8502
    "return true, if this is a nameSpace.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8503
     false is returned here - the method is only redefined in Namespace."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8504
5869
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  8505
    <resource:#obsolete>
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  8506
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8507
    self obsoleteMethodWarning:'use #isNameSpace'.
6805
f95ad1a82775 *** empty log message ***
ca
parents: 6800
diff changeset
  8508
    ^ self isNameSpace
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8509
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8510
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8511
isNil
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8512
    "Return true, if the receiver is nil.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8513
     Because isNil is redefined in UndefinedObject,
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8514
     the receiver is definitely not nil here, so unconditionally return false.
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8515
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8516
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8517
        - redefining it may not work as expected."
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8518
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8519
    ^ false
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8520
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8521
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8522
isNilOrEmptyCollection
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  8523
    "return true if I am nil or an empty collection - false here.
8833
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8524
     Obsolete, use isEmptyOrNil."
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8525
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8526
    <resource:#obsolete>
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8527
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8528
    ^ false
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  8529
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  8530
    "Modified: / 13.11.2001 / 13:28:06 / cg"
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8531
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8532
9005
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8533
isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8534
    "return true, if the receiver is some kind of collection, but not a String, ByteArray etc.;
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8535
     false is returned here - the method is redefined in Collection and UninterpretedBytes."
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8536
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8537
    ^ false
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8538
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8539
    "
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8540
        21 isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8541
        'abc' isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8542
        #'abc' isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8543
        #[1 2 3] isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8544
        #(1 2 3) isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8545
    "
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8546
!
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8547
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8548
isNumber
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8549
    "return true, if the receiver is some kind of number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8550
     false is returned here - the method is only redefined in Number."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8551
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8552
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8553
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8554
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8555
isOrderedCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8556
    "return true, if the receiver is some kind of ordered collection (or list etc);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8557
     false is returned here - the method is only redefined in OrderedCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8558
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8559
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8560
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8561
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8562
isPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8563
    "return true, if the receiver is some kind of point;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8564
     false is returned here - the method is only redefined in Point."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8565
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8566
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8567
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8568
9515
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8569
isProjectDefinition
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8570
    "return true, if the receiver is a projectDefinition.
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8571
     False is returned here - the method is only redefined in ProjectDefinition."
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8572
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8573
    ^ false
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8574
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8575
    "Created: / 10-08-2006 / 16:24:53 / cg"
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8576
!
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  8577
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8578
isRectangle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8579
    "return true, if the receiver is some kind of rectangle;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8580
     false is returned here - the method is only redefined in Rectangle."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8581
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8582
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8583
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8584
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8585
isRemoteObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8586
    "return true, if the receiver is some kind of remoteObject,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8587
     false if its local - the method is only redefined in RemoteObject."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8588
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8589
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8590
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8591
    "Created: 28.10.1996 / 15:18:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8592
    "Modified: 28.10.1996 / 15:20:57 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8593
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8594
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8595
isSequenceable
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8596
    "return true, if the receiver is some kind of sequenceable collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8597
     false is returned here - the method is only redefined in SequenceableCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8598
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8599
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8600
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8601
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8602
isSequenceableCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8603
    "OBSOLETE: use isSequenceable for ST-80 compatibility.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8604
     This method is a historic leftover and will be removed soon ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8605
     (although its name is much better than #isSequenceable - sigh)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8606
5869
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  8607
    <resource:#obsolete>
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  8608
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8609
    self obsoleteMethodWarning:'use #isSequenceable'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8610
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8611
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8612
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8613
isStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8614
    "return true, if the receiver is some kind of stream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8615
     false is returned here - the method is only redefined in Stream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8616
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8617
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8618
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8619
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8620
isString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8621
    "return true, if the receiver is some kind of string;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8622
     false is returned here - the method is only redefined in CharacterArray."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8623
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8624
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8625
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8626
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8627
isStringCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8628
    "return true, if the receiver is some kind of stringCollection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8629
     false is returned here - the method is only redefined in StringCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8630
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8631
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8632
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8633
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8634
isSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8635
    "return true, if the receiver is some kind of symbol;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8636
     false is returned here - the method is only redefined in Symbol."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8637
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8638
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8639
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8640
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8641
isText
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8642
    "return true, if the receiver is some kind of text object;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8643
     false is returned here - the method is only redefined in Text."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8644
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8645
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8646
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8647
    "Created: 12.5.1996 / 10:56:50 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8648
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8649
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8650
isValueModel
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8651
    "return true, if the receiver is some kind of valueModel;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8652
     false is returned here - the method is only redefined in ValueModel."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8653
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8654
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8655
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8656
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8657
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8658
isVariable
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8659
    "return true if the receiver has indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8660
     false otherwise."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8661
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8662
    ^ self class isVariable
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8663
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8664
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8665
isVariableBinding
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8666
    "return true, if this is a binding for a variable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8667
     false is returned here - the method is only redefined in Binding."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8668
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8669
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8670
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8671
    "Created: / 19.6.1997 / 17:38:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8672
    "Modified: / 8.5.1998 / 21:26:55 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8673
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8674
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8675
isView
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8676
    "return true, if the receiver is some kind of view;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8677
     false is returned here - the method is only redefined in View."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8678
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8679
    ^ false
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8680
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8681
6932
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8682
notEmptyOrNil
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8683
    "Squeak compatibility:
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8684
     return true if I am neither nil nor an empty collection.
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8685
     Return true here."
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8686
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8687
    ^ true
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8688
!
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8689
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8690
notNil
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8691
    "Return true, if the receiver is not nil.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8692
     Because notNil is redefined in UndefinedObject,
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8693
     the receiver is definitely not nil here, so unconditionally return true.
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8694
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8695
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8696
        - redefining it may not work as expected."
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8697
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8698
    ^ true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8699
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8700
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8701
!Object methodsFor:'tracing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8702
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8703
traceInto:aRequestor level:level from:referrer
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8704
    "double dispatch into tracer, passing my type implicitely in the selector"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8705
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8706
    ^ aRequestor traceObject:self level:level from:referrer
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8708
    "Created: / 2.9.1999 / 09:05:17 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8709
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8710
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8711
!Object methodsFor:'user interaction & notifications'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8712
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8713
activityNotification:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8714
    "this can be sent from deeply nested methods, which are going to perform
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8715
     some long-time activity.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8716
     If there is a handler for the ActivityNotificationSignal signal, that one is raised,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8717
     passing the argument. The handler should show this message whereever it likes,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8718
     and proceed. If there is no handler, this is simply ignored.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8719
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8720
     This is very useful to pass busy messages up to some higher level (typically a view)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8721
     which likes to display that message in its label or a busy-box.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8722
     It could also be put into some logfile or printed on the standard output/error."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8723
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  8724
    ActivityNotification isHandled ifTrue:[
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  8725
        ^ ActivityNotification raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8726
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8727
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8728
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8729
     nil activityNotification:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8730
     self activityNotification:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8731
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8732
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8733
    "
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  8734
     ActivityNotification handle:[:ex |
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  8735
        ex errorString printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8736
        ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8737
     ] do:[
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  8738
        'hello' printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8739
        self activityNotification:'doing some long time computation'.
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  8740
        'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8741
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8742
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8743
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8744
    "Modified: 16.12.1995 / 18:23:42 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8745
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8746
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8747
confirm:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8748
    "launch a confirmer, which allows user to enter yes or no.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8749
     return true for yes, false for no.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8750
     If no GUI is present (headless applications), true is returned."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8751
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8752
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8753
     on systems without GUI, or during startup, output a message
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8754
     and return true (as if yes was answered)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8755
     Q: should we ask user by reading Stdin ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8756
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8757
    Smalltalk isInitialized ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8758
        '*** confirmation requested during initialization:' errorPrintCR. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8759
        aString errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8760
        '*** I''ll continue, assuming <yes> ...' errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8761
        ^ true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8762
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8763
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8764
    (Dialog isNil 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8765
    or:[Screen isNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8766
    or:[Screen current isNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8767
    or:[Screen current isOpen not]]]) ifTrue:[       
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8768
        'confirm: ' infoPrint.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8769
        aString infoPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8770
        'continue, assuming <yes>' infoPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8771
        ^ true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8772
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8773
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8774
    Dialog autoload.        "in case its autoloaded"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8775
    ^ Dialog confirm:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8776
        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8777
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8778
     nil confirm:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8779
     self confirm:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8780
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8781
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8782
    "Modified: 20.5.1996 / 10:28:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8783
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8784
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8785
confirm:aString orCancel:cancelBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8786
    "launch a confirmer, which allows user to enter yes, no or cancel.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8787
     return true for yes, false for no, or the value from cancelBlock for cancel.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8788
     If no GUI is present (headless applications), cancelBlock is returned."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8789
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8790
    |answer|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8791
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8792
    answer := self confirmWithCancel:aString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8793
    answer isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8794
        ^ cancelBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8795
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8796
    ^ answer
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8797
        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8798
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8799
     self confirm:'hello' orCancel:[self halt]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8800
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8801
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8802
    "Modified: 20.5.1996 / 10:28:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8803
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8804
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8805
confirmWithCancel:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8806
    "launch a confirmer, which allows user to enter yes, no or cancel.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8807
     return true for yes, false for no, nil for cancel.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8808
     If no GUI is present (headless applications), nil is returned."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8809
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8810
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8811
     on systems without GUI, or during startup, output a message
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8812
     and return true (as if yes was answered)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8813
     Q: should we ask user by reading Stdin ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8814
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8815
    Smalltalk isInitialized ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8816
        '*** confirmation requested during initialization:' errorPrintCR. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8817
        aString errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8818
        '*** I''ll continue, assuming <cancel> ...' errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8819
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8820
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8821
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8822
    (Dialog isNil 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8823
    or:[Screen isNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8824
    or:[Screen current isNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8825
    or:[Screen current isOpen not]]]) ifTrue:[       
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8826
        'confirm: ' infoPrint.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8827
        aString infoPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8828
        'continue, assuming <cancel>' infoPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8829
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8830
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8831
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8832
    Dialog autoload.        "in case its autoloaded"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8833
    ^ Dialog confirmWithCancel:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8834
        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8835
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8836
     nil confirmWithCancel:'hello' 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8837
     self confirmWithCancel:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8838
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8839
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8840
    "Modified: 20.5.1996 / 10:28:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8841
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8842
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8843
errorNotify:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8844
    "launch a Notifier, showing top stack, telling user something
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8845
     and give user a chance to enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8846
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8847
    ^ self
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8848
        errorNotify:aString 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8849
        from:thisContext sender
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8850
        allowDebug:true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8851
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8852
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8853
     nil errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8854
     self errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8855
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8856
6199
5fcf06f17cee *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6196
diff changeset
  8857
    "Modified: / 16.11.2001 / 15:36:49 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8858
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8859
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8860
errorNotify:aString from:aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8861
    "launch a Notifier, showing top stack (above aContext), 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8862
     telling user something and give user a chance to enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8863
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8864
    ^ self errorNotify:aString from:aContext allowDebug:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8865
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8866
    "Modified: / 17.8.1998 / 10:09:27 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8867
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8868
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8869
errorNotify:aString from:aContext allowDebug:allowDebug
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8870
    "launch a Notifier, showing top stack (above aContext), 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8871
     telling user something and optionally give the user a chance to enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8872
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8873
    |currentScreen con sender action boxLabels boxValues default|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8874
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8875
    Smalltalk isInitialized ifFalse:[
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8876
        'errorNotification: ' print. aString printCR.
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8877
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8878
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8879
    (Dialog isNil 
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8880
     or:[Screen isNil
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8881
     or:[(currentScreen := Screen current) isNil
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8882
     or:[currentScreen isOpen not]]]) ifTrue:[       
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8883
        "
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8884
         on systems without GUI, simply show
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8885
         the message on the Transcript and abort.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8886
        "
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8887
        Transcript showCR:aString.
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8888
        AbortOperationRequest raise.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8889
        "not reached"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8890
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8891
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8892
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8893
    Processor activeProcessIsSystemProcess ifTrue:[
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8894
        action := #debug.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8895
        sender := aContext.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8896
        Debugger isNil ifTrue:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8897
            '****************** Cought Error while in SystemProcess ****************' errorPrintCR.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8898
            thisContext fullPrintAll.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8899
            action := #abort.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8900
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8901
    ] ifFalse:[
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8902
        Dialog autoload.        "in case it's autoloaded"
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8903
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8904
        Error handle:[:ex |
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8905
            "/ a recursive error - quickly enter debugger
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8906
            "/ this happened, when I corrupted the Dialog class ...
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  8907
            ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR.
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8908
            action := #debug.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8909
            ex return.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8910
        ] do:[ |s|
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8911
            sender := aContext.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8912
            sender isNil ifTrue:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8913
                sender := thisContext sender.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8914
            ].
7576
7e2e97bd0973 interrestingContextFrom - duplicated code removed
Claus Gittinger <cg@exept.de>
parents: 7567
diff changeset
  8915
            con := sender.
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8916
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8917
            "/ skip intermediate (signal & exception) contexts
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8918
            DebugView notNil ifTrue:[
7576
7e2e97bd0973 interrestingContextFrom - duplicated code removed
Claus Gittinger <cg@exept.de>
parents: 7567
diff changeset
  8919
                con := DebugView interestingContextFrom:sender
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8920
            ].
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8921
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8922
            "/ show the first few contexts
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8923
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8924
            s := WriteStream with:aString.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8925
            s cr; cr.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8926
            1 to:15 do:[:n |
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8927
                con notNil ifTrue:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8928
                    con printOn:s.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8929
                    s cr.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8930
                    con := con sender
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8931
                ]
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8932
            ].
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8933
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8934
            (allowDebug and:[Debugger notNil]) ifTrue:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8935
                boxLabels := #('Proceed' 'Abort' 'Copy Trace and Abort' 'Debug').
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8936
                boxValues := #(#proceed  #abort  #copy                  #debug).
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8937
                default := #debug.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8938
            ] ifFalse:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8939
                boxLabels := #('Proceed' 'Abort' 'Copy Trace and Abort').
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8940
                boxValues := #(#proceed  #abort  #copy).
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8941
                default := #abort.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8942
            ].
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8943
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8944
            action := Dialog 
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8945
                    choose:s contents 
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8946
                    label:('Exception [' , Processor activeProcess nameOrId , ']')
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8947
                    image:WarningBox errorIconBitmap
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8948
                    labels:boxLabels
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8949
                    values:boxValues
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8950
                    default:default
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8951
                    onCancel:nil.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8952
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8953
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8954
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8955
    action == #debug ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8956
        ^ Debugger enter:sender withMessage:aString mayProceed:true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8957
    ] ifFalse:[
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8958
        action == #proceed ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8959
            ^ nil.
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8960
        ].
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8961
        action == #copy ifTrue:[ |s|
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8962
            s := '' writeStream.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8963
            sender fullPrintAllOn:s.
8563
9ea42d4571b5 set selection interface changed
ca
parents: 8555
diff changeset
  8964
            currentScreen rootView setClipboardText:s contents.
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  8965
        ].
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8966
        AbortOperationRequest raise.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8967
        "not reached"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8968
    ].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  8969
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8970
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8971
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8972
     nil errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8973
     self errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8974
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8975
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8976
    "Created: / 17.8.1998 / 10:09:26 / cg"
6199
5fcf06f17cee *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6196
diff changeset
  8977
    "Modified: / 16.11.2001 / 15:40:12 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8978
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8979
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8980
information:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8981
    "launch an InfoBox, telling user something. 
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  8982
     These info-boxes can be suppressed by handling  
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  8983
     UserNotification or InformationSignal and proceeding in the handler.
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  8984
     Use #notify: for more important messages.
8371
4493f5ac7405 *** empty log message ***
ca
parents: 8330
diff changeset
  8985
     If nobody handles the exception, the default action of UserNotification
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  8986
     pops up a warn dialog."
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  8987
7035
1d049fb7ae5a Make UserInformation a class based exception
Stefan Vogel <sv@exept.de>
parents: 7033
diff changeset
  8988
    UserInformation raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8989
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8990
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8991
     nil information:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8992
     self information:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8993
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8994
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8995
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8996
     InformationSignal handle:[:ex |
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  8997
        'no box popped' printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8998
        ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8999
     ] do:[
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9000
        'hello' printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9001
        self information:'some info'.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9002
        'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9003
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9004
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9005
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9006
    "Modified: 24.11.1995 / 22:29:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9007
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9008
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9009
notify:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9010
    "launch a Notifier, telling user something.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9011
     Use #information: for ignorable messages.
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9012
     If nobody handles the exception, the dafault action of UserNotification
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9013
     pops up a warn dialog."
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9014
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9015
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9016
    Smalltalk isInitialized ifFalse:[
6656
e434adf0a1f3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6654
diff changeset
  9017
        "/ thisContext fullPrintAll.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9018
        'information: ' print. aString printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9019
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9020
    ].
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9021
    UserNotification raiseRequestWith:self errorString:aString.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9022
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9023
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9024
     nil notify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9025
     self notify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9026
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9027
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9028
    "Modified: 20.5.1996 / 10:28:48 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9029
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9030
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9031
warn:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9032
    "launch a WarningBox, telling user something.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9033
     These warn-boxes can be suppressed by handling the 
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9034
     UserNotification- or WarningSignal and proceeding in the handler.
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9035
     If nobody handles the exception, the dafault action of Warning
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9036
     pops up a warn dialog."
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9037
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9038
    Warning raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9039
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9040
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9041
     nil warn:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9042
     self warn:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9043
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9044
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9045
    "
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9046
     Warning handle:[:ex |
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9047
        Transcript showCR:ex description.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9048
        ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9049
     ] do:[
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9050
        'hello' printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9051
        self warn:'some info'.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9052
        'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9053
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9054
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9055
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9056
    "Modified: 20.5.1996 / 10:28:53 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9057
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9058
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9059
!Object methodsFor:'visiting'!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9060
8426
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9061
acceptVisitor:aVisitor
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9062
    "double-dispatch onto a Visitor."
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9063
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9064
    ^ self acceptVisitor:aVisitor with:nil
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9065
!
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9066
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9067
acceptVisitor:aVisitor with:aParameter
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9068
    "double-dispatch onto a Visitor.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9069
     Subclasses redefine this"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9070
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9071
    ^ aVisitor visitObject:self with:aParameter
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9072
!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9073
8879
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9074
elementDescriptorFor:anAspectSymbol
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9075
    "answer a collection of associations containing the
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9076
     objects state to be encoded for aspect.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9077
     Association key is the instance variable name or access selector,
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9078
     association value is the contents of the instance variable.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9079
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9080
     The default is to return the contents of all non-nil instance variables"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9081
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9082
    |ret|
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9083
8879
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9084
    ret := 0.
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9085
    anAspectSymbol notNil ifTrue:[
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9086
        ret := self perform:anAspectSymbol ifNotUnderstood:[0].
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9087
    ].
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9088
    ret == 0 ifTrue:[
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9089
        ^ self elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9090
    ].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9091
    ^ ret.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9092
!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9093
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9094
elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9095
    "return all instance variables for visiting/encoding"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9096
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9097
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | true].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9098
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9099
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9100
      #(1 2 3 nil true symbol) elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9101
      Dictionary new elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9102
      (5 @ nil) elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9103
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9104
!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9105
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9106
elementDescriptorForInstanceVariablesMatching:aBlock
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9107
    "return all instance variables which conform to aBlock, for encoding/visiting.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9108
     Indexed vars are all included."
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9109
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9110
    |instVarNames theClass children
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9111
     instSize "{ Class: SmallInteger }" 
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9112
     varSize "{ Class: SmallInteger }"|
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9113
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9114
    theClass := self class.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9115
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9116
    instSize := theClass instSize.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9117
    varSize := theClass isVariable ifTrue:[self basicSize] ifFalse:[0].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9118
    children := OrderedCollection new:(instSize + varSize).
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9119
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9120
    instVarNames := theClass allInstVarNames.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9121
    1 to:instSize do:[:i | |var|
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9122
        var := self instVarAt:i.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9123
        (aBlock value:var) ifTrue:[
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9124
            children add:((instVarNames at:i) -> var)
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9125
        ]
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9126
    ].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9127
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9128
    varSize ~~ 0 ifTrue:[
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9129
        1 to:varSize do:[:i |
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9130
            children add:(i -> (self basicAt:i))
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9131
        ]
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9132
    ].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9133
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9134
    ^ children.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9135
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9136
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9137
      #(1 2 3 nil true symbol) elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9138
      Dictionary new elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9139
      (5 @ nil) elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9140
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9141
!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9142
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9143
elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9144
    "return all non-nil instance variables for visiting/encoding"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9145
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9146
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | val notNil].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9147
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9148
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9149
      #(1 2 3 nil true symbol) elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9150
      Dictionary new elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9151
      (5 @ nil) elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9152
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9153
! !
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9154
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9155
!Object class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  9156
5754
333aba8041c2 checkin from browser
tm
parents: 5706
diff changeset
  9157
version
9657
3fa7b94ff781 boss stuff separated
Claus Gittinger <cg@exept.de>
parents: 9643
diff changeset
  9158
    ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.566 2006-08-23 14:06:59 cg Exp $'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  9159
! !
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  9160
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9161
Object initialize!